Collected Algorithms from ACM 


IN THREE VOLUMES 


A collation of all ACM Algorithms, including Certifications, Remarks, and Translations 
from the Algorithms Department of Communications of the ACM, 1960-1975, from 
~ACM Transactions on Mathematical Software, 1975 ff, and from ACM Transactions on 

Programming Languages and Systems, 1981 ff. 


Introductory Information 
Volume Ill. Algorithms 493ff. 


1981 


A Service of the Association for Computing Machinery, Inc. 
1133 Avenue of the Americas 
New York, New York 10036 


Quarterly Updating Service Available by Annual Subscription 


ACM Algorithms 493ff. are available by purchase in the form of 
listing, or card deck, or magnetic tape (9 track EBCDIC, 9 track 
ASCII, 7 track BCD), from ACM Algorithms Distribution Service, 
c/o International Mathematical & Statistical Libraries, Inc., Sixth 
Floor, GNB Building, 7500 Bellaire Boulevard, Houston, TX 77036. 


Copyright © 1981, Association for Computing Machinery, Inc. 
The algorithms and other items in this compilation are all excerpted from copyright ACM publications unless otherwise noted. 


Association for Computing Machinery memo 


1133 AVENUE OF THE AMERICAS 
NEW YORK, N. Y. 10036 5 
(212) 265-6300 


December 28, 1981 


TO: Subscribers to "Collected Algorithms from ACM" 


RE: Supplement No. 80 


Attached is the quarterly set of sheets for your loose-leaf volume, 
"Collected Algorithms from ACM." The sheets in this Supplement provide 
the material that appeared in the algorithms section of the December 
1981 issue of TRANSACTIONS ON MATHEMATICAL SOFTWARE. 


The sheets for the new algorithms 578, 579, and 580 should be added to 
the back of the volume in the following order: 


578-P1-0 (backed by 578-P2-0) to 578-P3-0 (backed by 578-P4-0) 
579-P1-0 (backed by 579-P2-0) to 579-P5-0 (backed by blank) 
580-P1-0 (backed by 580-P2-0) 


The sheets containing the CALGO 20-year Index should be inserted with 
front matter in the loose-leaf binder immediately following page xiv. 


Association for Computing Machinery memo 
11 WEST 42ND STREET a | 


NEW YORK, N.Y. 10036 : sd) 
(212) 869-7440 ye 


April 26, 1982 = 


TO: Subscribers to "Collected Algorithms from ACM" 


RE: Supplement No. 81 


Attached is the quarterly set of sheets for your loose-leaf volume, 
"Collected Algorithms from ACM." The sheets in this Supplement provide 
the material that appeared in the Algorithms Section of the March 1982 
issue of TRANSACTIONS ON MATHEMATICAL SOFTWARE. 


The sheets for the new algorithm 581 should be added to the back of the 
volume in the following order: 


581-P1-0 (backed by 581-P2-0) to 581-P3-0 (backed by 581-P4-0) 


The sheets to update algorithms previously provided should be incor- 
porated as follows: 


DELETE INSERT 
334-P1-Rl1 (backed by blank) 334-P1-R1 (backed by 334-P2-0) 


The updated version of the "ACM Algorithms Policy" should replace the 
one now in the frontmatter, pages ix-xi. 


The 1981 Index by Subject to Algorithms should precede the Index by 
Subject to Algorithms, 1960-1980(pages xv-xxvi). 


Association for Computing Machinery memo 
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11 WEST 42ND STREET 


NEW YORK, N.Y. 10036 semen 


(212) 869-7440 Pan 


July 9, 1982 


TO: Subscribers to "Collected Algorithms from ACM" 


RE: Supplement No. 82 


Attached is the quarterly set of sheets for your looseleaf volume, 
"Collected Algorithms from ACM." The sheets in this Supplement provide 
the material that appeared in the algorithms section of the June 1982 
issue of TRANSACTIONS ON MATHEMATICAL SOFTWARE. 


The sheets for the new algorithms 582, 583, and 584 should be added to 
the back of the volume in the following order: 


582-P1-0 (backed by 582-P2-0) to 582-P3-0 (backed by 582-P4-0) 
583-P1-0 (backed by 583-P2-0) to 583-P11-0 (backed by 583-P12-0) 
584-P1-0 (backed by 584-P2-0) to 584-P7-0 (backed by 584-P8-0) 


The sheets to update algorithms previously provided should be incorpor- 
ated in the looseleaf binders as follows: 


DELETE INSERT 
506-P11-0 (backed by blank) 506-P11-0 (backed by 506-P12-0) 
508-P9-0 (backed by 508-P10-0) 508-P9-0 (backed by 508-P10-R1) 
509-P9-0 (backed by 509-P10-0) 509-P9-0 (backed by 509-P10-R1) 


For those with casebound volumes, the editor suggests that you insert 
the algorithm updates in the volume where the algorithm appears. 


Association for Computing Machinery memo 


11 WEST 42ND STREET 
‘NEW YORK, N.Y. 10036 
+ (212) 869-7440 


acm 


October 4, 1982 


TO: Subscribers to "Collected Algorithms from ACM" 
RE: Supplement No. 83 


Attached is the quarterly set of sheets for your looseleaf volume, 
"Collected Algorithms from ACM." The sheets in this Supplement provide 
the material that appeared in the algorithms section of the September 
1982 issue of TRANSACTIONS ON MATHEMATICAL SOFTWARE. 


The sheets for the new algorithms 585, 586, and 587 should be added 
to the back of the volume in the following order: 


585-P1-O(backed by 585-P2-0) to 585-P9-0 (backed by 585-P10-0) 
586-P1-O(backed by 586-P2-0) to 586-P17-O(backed by blank) 
587-P1-O0 (backed by 587-P2-0) to 587-P9-0 (backed by blank) 


The sheets to update algorithms previously provided should be incor- 
porated in the looseleaf binders as follows: 


DELETE INSERT 
507-P9-0 (backed by 507--P10-0) 507-P9-0(backed by 507-P10-R1) 


For those with casebound volumes, the editor suggests that you insert 
the algorithm updates in the volume where the algorithm appears. 


uunpue. 


Association for Computing Machinery memo 


11 WEST 42ND STREET 
NEW YORK, N.Y. 10036 
(212) 869-7440 


January 3, 1983 


To: Subscribers to "Collected Algorithms from ACM" 
RE: Supplement No. 84 


Attached is the quarterly set of sheets for your looseleaf volume, 
"Collected Algorithms from ACM." The sheets in this Supplement provide 
the material that appeared in the Algorithms section of the December 
1982 issue of TRANSACTIONS ON MATHEMATICAL SOFTWARE. 


The sheets for the algorithms 588, 589, 590, and 591 should be added 
to the back of the volume in the following manner: 


588-P1-0 (backed by 588-P2-0) 

589-P1-0(backed by 589-P2-0) to 589-P3-0 (backed by 589-P4-0) 
590-P1-0 (backed by 590-P2-0) to 590-P5-0(backed by 590-P6-0) 
591-P1-0 (backed by 591-P2-0) to 591-P15-0(backed by 591-P16-0) 


The sheets to update algorithms previously provided should be incor- 
porated in the looseleaf binders as follows: 


DELETE INSERT 
535~P17-0 (backed by 535-P18-0) 535-P17-0(backed by 535-P18-R1) 
539-31-0(backed by blank) 539—P31-R1 (backed by 539-P32-0) 
539-P33-0(backed by blank) 
580-P1-0 (580-P 2-0) 580-P1-0 (backed by 580-P2-R1) 


The "1982 Index by Subject to Algorithms" should be inserted in 
front of looseleaf binder with other indexes. 


For those with casebound volumes, the editor suggests that you insert 
the algorithm updates in the volume where the algorithm appears. 


winpue. 
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Collected Algorithms from ACM 


Introductory Information 


Preface 


The Algorithms department of Communications of the 
ACM (CACM) was established in February 1960, with 
J. H. Wegstein as editor, for the purpose of publishing 
algorithms, consisting of procedures and programs, in 
the Algol language. In 1975 the publication of ACM 
algorithms material was transferred to ACM Transac- 
tions on Mathematical Software (TOMS) and in 1981 
ACM Transactions on Programming Languages and Sys- 
tems (TOPLAS) published its first algorithm. A wide 
variety of algorithms have been published and many of 
them have been used heavily—either in original form or 
as translated into other languages. Recognizing the gen- 
eral acceptance of the algorithm material published in 
CACM, TOMS, and TOPLAS the Association for Com- 
puting Machinery (ACM) has collected and reprinted 
the algorithms to make them more readily accessible and 
more serviceable to a larger group of users. 

The collection contains all algorithms published in the 
Algorithms departments of CACM, TOMS, and TO- 
PLAS. Covering a great variety of subjects, these algo- 
rithms include many for standard computational tasks, 
such as evaluation of special functions, solution of sys- 
tems of linear equations, estimation of definite integrals, 
and sorting of data. Most of them are written in Algol or 
ANS Fortran. 


Both to conserve space and because of changing lan-- 


guage usage, reference material on ALGOL and Fortran, 
[6], [7], [10]-[13], is no longer included as it was in earlier 
editions. Other expositions of ALGOL are given in [2], 
[3], [8], and [9]. A new Fortran standard was adopted by 
ANSI in 1978. The official ANSI document for the new 
Fortran standard [14] is not yet published, but a sum- 
mary is given in [4]. 

A cumulative index to algorithms published since 1960 
is provided. In addition to algorithms published in 
CACM, TOMS, and TOPLAS the index lists many 
which appeared elsewhere. The classification scheme is 
a modified form of the SHARE classification. The early 
indéxes were prepared by G. E. Forsythe (Algorithms 
department editor in 1964) and J. M. Varah, and suc- 
ceeding editors have annually issued updated versions. 

Algorithms 1-220 were originally published as re- 
ceived—-without any refereeing whatever. Many of these 
have since been certified and/or corrected by their au- 
thors or by other contributors. Beginning with Algorithm 
221, in March 1964, all algorithms have been refereed 
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independently. For many, Certifications have appeared, 
and modifications to some have been proposed in Re- 
marks. In this volume, Certifications and Remarks for a 
given algorithm are collected with the algorithm. 

Since 1964 an effort has been made to choose for 
publication those of the refereed algorithms that are 
interesting and of good quality and, at the same time, 
likely to be useful to others. Probably few of these 
algorithms would satisfy all the criteria for excellence 
proposed by G. E. Forsythe [5]. However, it is hoped 
that many will be useful and will help to disseminate 
good methods of solution for many problems. Some of 
the earlier algorithms which were not refereed are very 
good too, but those having Certifications and/or correc- 
tions (included in Remarks) are more likely to be valu- 
able. It is hoped that users of those without Certifications 
or Remarks will contribute their experiences to TOMS 
or TOPLAS so that all may benefit from them. Algo- 
rithms 1-50 have been reprinted with revisions and 
corrections by Ageev, Alik, and Galis in the Soviet 
Union [1]. 

For general information, the present Algorithms Pol- 
icy Statement of TOMS and TOPLAS is provided. The 
Dissemination Agreement is of particular importance: 
Submittal of an algorithm for publication in TOMS or 
TOPLAS implies that unrestricted use of the algorithm 
within a computer is permissible. General permission to 
copy the algorithm in fair use, but not for profit, is 
granted provided ACM’s copyright notice is given and 
reference is made to this publication, its date of issue, 
and to the fact that copying is by permission of the 
Association for Computing Machinery. 

As new Algorithms, Certifications, Remarks, and 
Translations appear in TOMS or TOPLAS, they are 
reissued quarterly to Collected Algorithms subscribers, 
in loose-leaf form, so that their collections may be kept 
up to date. 

Beginning with Algorithm 493, algorithms are avail- 
able in machine-readable form—tapes or cards—-from 
ACM Algorithms Distribution Service, c/o IMSL, Sixth 
Floor, GNB Building, 7500 Bellaire Boulevard, Houston, 
TX 77063. 

To facilitate the updating and to make this volume 
convenient to use, an understanding of the page num- 
bering scheme for the algorithms is helpful. The page 
designation is in a three-part format: the left part is the 
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algorithm number; the middle part is the page number 
within the algorithm (the first page of each algorithm is 
P1); and the right part is the number of the revision of 
that page. All sheets in the original, or first, insertion of 
an algorithm have “0” for the right part. The first 
revision of a page will have a page number having the 
left and middle parts identical with those on the page to 
be replaced, but the right part will be “RI” instead of 
“0.” The second revision of the same page would read 
R2, and so on. For example, 123-P2-R1 would mean the 
first revision of page 2 of Algorithm 123. Revised pages 
for an algorithm, or additional pages if required, are 
provided when Certifications or Remarks are added. 

The Introduction that appeared in Collected Algo- 
rithms at its inception was written by John G. Herriot, 
department editor at that time. It was then revised by 
Fred T. Krogh, Algorithms Editor from 1976 to 1978. 
As present Algorithms Editor, I have prepared this re- 
vision to include current information. 


Webb Miller 
Algorithms Editor 
Collected Algorithms from ACM 
Department of Mathematics 
University of California 
Santa Barbara, California 93106 
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ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE 


ACM Algorithms Policy 


BY FRED T. KROGH" 


Matters of Content 


A contribution should be in the form of an algorithm, comparison, certification, 
remark, or translation. 


Algorithms 


ACM Algorithms are published to make the fruits of software research readily 
available to as wide an audience as possible. An algorithm must either provide a 
capability not readily available or perform a task better in some way than has 
been done before. “Better” can mean anything from improved reliability or 
efficiency to more attractive packaging. In all cases, an algorithm must be of 
lasting value and must represent a substantial contribution in terms of the 
amount of work or the originality required for its creation. 


In most cases the communication of new algorithmic ideas should be done either 
in a companion paper published in one of the ACM Transactions or in previously 
published work. The textual part of an algorithm submission should give a brief 
description of what the algorithm does and pertinent information on usage and 
maintenance. It should not duplicate information in another paper or in the 
algorithm listing. It is recognized that certain algorithms will be useful to readers 
of one of the ACM Transactions but deal with subjects not in the usual research 
domain of that journal. When appropriate, the Algorithms Editor will guide 
authors to other ACM journals for possible publication of such algorithms. 


An ACM algorithm must be complete, portable, well documented, and well 
structured. The meaning of these terms is clarified below. 


1. Completeness: With the exception of code used from a previously published 
ACM algorithm, a submission must include all of the code and test data 
necessary for the effective use and testing of the algorithm by a large segment 
of its intended audience. To assist those who use the algorithm, a small test 
driver should be provided that illustrates the use of the algorithm for a 
simple test problem. For testing purposes, one should provide in a single 
driver a sufficient variety of test cases to exercise all the main features of the 
code. All submitted code, including test drivers and preprocessors, is subject 
to the refereeing process. Code subject to more restricted use than specified 
in this policy may be used in a supporting role for an algorithm provided it 
is available from an established source for a nominal fee, and there is no 
nearly equivalent code available in the public domain. 

2. Portability: It must be possible to move the code in machine readable form 
from one machine to another with only minor, well-documented changes. 
Programs written in a language having several popular dialects should use 
only language features common to those dialects. As initial evidence of 
portability, the author can either include evidence of successful execution on 
three different computers, i.e., computers with different basic instruction 
sets, or better, when available, can give the result of running the software 
through a verifier that checks the code for portability or conformance to a 
standard. All FORTRAN programs must satisfy one of the following criteria: 


(a) Conformance with the ANSI X3.9-1978 FORTRAN 77 [1]. 


' Policy revised March 1979, by Webb Miller; January 1982, by R. J. Hanson. 
ACM Transactions on Mathematical Software, Vol. 8, No. 1, March 1982, Pages 1-4. 


2 . Fred T. Krogh 


(b) Pass the set of tests performed by the PFORT verifier [4]. 


The Algorithms Editor will attempt to help authors who have trouble 
meeting either of these requirements. The PFORT verifier can be obtained 
at no cost from the Editor. 


Machine-dependent modules, including assembly language, may be used 
provided: 


(a) They are clearly specified, limited in function, small, and either nec- 
essary or a substantial improvement over equivalent portable proce- 
dures. 

(b) Where possible, portable versions are also submitted to facilitate 
installation and testing, and to confirm the reader’s understanding of 
the specifications. If portable versions are not provided, then tested 
versions for at least three different computers must be provided. 

(c) A portable test program is provided which exhaustively tests each 
machine-dependent module of the package. 


3. Documentation: Each module of the code, including test drivers, must be 
adequately commented. Comments should include the purpose of the module, 
definitions of all arguments passed through the calling sequence, through 
global variable declarations, or obtained via input, and comments setting off 
and explaining major parts of the code. Comments defining machine depen- 
dencies should be gathered together and clearly flagged. Standard names and 
definitions for machine constants are normally to be used [2]. If these 
constants are used widely in the submitted algorithms, then they may be 
accessed through a procedure [3]. Other constants clearly identified in 
comments (e.g., BIG=SQRT (SOVFLO)) and machine dependencies not in 
the standard [3], may be introduced. A comment can simply point to the 
place where full comments are given in cases where large comment blocks 
would otherwise be repeated. An alphabetical list of internal variables 
together with how they are used is highly recommended. (Identify temporary 
variables as temporary.) At present, it is not possible to edit comments to 
provide a reference to the place in the journal where the algorithm appears. 
Machine-readable documentation giving more detailed information about 
the package than can be published is encouraged. 

4. Structure: Code should be organized so that it is easy to use and modify, yet 
flexible enough to be useful for most problems in the problem area covered. 
Indentation should be used to identify loops, compound statements and 
blocks, and continuation of a statement onto another line. If integers are 
used for statement labels, they must be strictly increasing and should be far 
enough apart to allow for future modifications. If the space required by an 
array is highly problem dependent, then that array should have a variable 
dimension. (NOTE: FORTRAN requires common blocks with the same 
name to have the same length.) 


Algorithmic ideas may be published as integral parts of regular papers without 
meeting these criteria. This provision may not, however, be used as a subterfuge 
to circumvent meeting the criteria for ACM algorithms. 


Except for extremely long algorithms, all contributions will appear in their 
entirety in ACM’s looseleaf algorithms periodical Collected Algorithms from 
ACM (CALGO). Algorithms are available in machine-readable form through the 
ACM Algorithms Distribution Service. 


? The PFORT verifier checks a FORTRAN program for conformance with a portable subset of the 
former ANSI X3.9-1966 FORTRAN standard. 


ACM Transactions on Mathematical Software, Vol. 8, No. 1, March 1982. 
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Comparisons 

A comparison is a report on the relative merits and features of highly similar 
software packages for a specific subject area. This study normally includes 
reporting and interpreting various cogent observed facts about the packages. 
These facts are typically based on solving a common set of test problems. The 
drivers, test problems, and data used in the study are to be sent to the Algorithms 
Editor, at the time of submission, as an algorithm. This body of information will 
be used in the refereeing process and will be available as an ACM Algorithm. 


Certifications 

A certification is a report on a previously published algorithm. It can be a careful 
study of performance characteristics, a verification of correctness, or a report on 
extensive testing. 


Remarks 
A remark is a brief report on a previously published algorithm. It is usually 
concerned with corrections or modifications. 


Translations 

A translation may either provide machine-dependent modules for a machine. or 
operating system not covered by an ACM algorithm, or a translation of the 
algorithm into a different high-level language. A translation will only be consid- 
ered if it is a translation of an algorithm that still represents the current state of 
the art and it satisfies all of the criteria of a regular algorithm submission. 


Submission Formalities 

1. Five copies of all textual material should be sent to the Algorithms Editor. 
This material must be typewritten and double spaced. Companion papers to 
algorithms submitted to one of the ACM Transactions should be sent with the 
algorithm to the Algorithms Editor, as they will be refereed along with the 
algorithm. The purpose of those parts of the code submission that are included 
for testing purposes or serve only a supporting role should be clearly identified. 

2. Processing of an algorithm will not proceed until it is verified that machine- 
readable copy of the algorithm has arrived in good form. Before sending 
machine-readable copy, contact the Algorithms Editor and explain the com- 
puter(s) available to you, the size of your submission, and in what form you 
would like to send the material. If an algorithm requires the use of code subject 
to restricted use, the use of this code should be cleared first with the Algorithms 
Editor. 

3. Evidence of portability must be included with an algorithm submission. 


Dissemination Agreement 

Submittal of an algorithm for publication in one of the ACM Transactions 
implies that unrestricted use of the algorithm within a computer is permissible. 
General permission to copy and distribute the algorithm without fee is granted 
provided that the copies are not made or distributed for direct commercial 
advantage. The ACM copyright notice and the title of the publication and its 
date appear, and notice is given that copying is by permission of the Association 
for Computing Machinery. To copy otherwise, or to republish, requires a fee and/ 
or specific permission. 


Copyright Agreement 

Authors of copyrightable algorithms (or their employers) are required to transfer 
the copyright to ACM upon acceptance of the algorithm for publication, in 
accordance with ACM policy to own copyright on ACM published material. The 
Association grants to authors the right to reuse their material and seeks the 
permission of authors before approving republication. 


4 ° Fred T. Krogh 
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Software Package Policy 


The ACM Algorithm Distribution Service makes it pos- 
sible to remove the length limitation on algorithms pub- 
lished in TOMS and TOPLAS and allows them to 
publish and disseminate large programs. 

Technically, a collection of algorithms is just another 
algorithm, but practically ACM editors will distinguish 
between “ordinary” algorithms and larger entities called 
polyalgorithms, software packages, systemized collec- 
tions, etc. This policy statement is an extension of the 
algorithms policy of TOMS and TOPLAS which de- 
scribes those software packages that these Transactions 
are interested in publishing and gives the specific require- 
ments expected for such packages. 


General Criteria and Procedures 


Usefulness is an important criterion for the acceptance 
of any ACM algorithm; it is an essential criterion for 
ACM software packages. An acceptable ACM package 
must address itself to a standard and widely occurring 
problem set. Furthermore, it must be designed to ease 
the user’s task as much as possible consistent with the 
nature of the problem set. The human engineering as- 
pects of the package will be weighted heavily in its 
evaluation by the editors. 

All ACM algorithms, but especially packages, are 
expected to be of high quality in all respects. ACM 
packages must use good algorithms in their components, 
they must use good programming (including style, struc- 
ture, and adherence to standards), they must be well 
documented (both for use and modification), and they 
must be thoroughly tested and evaluated. 

Transportability will also be weighted heavily in that 
it directly affects usefulness. A wonderful package will 
not be accepted if it requires a specific environment of 
machine, operating system and I/O devices that is avail- 
able only at a very few locations. However, complete 
transportability will not be insisted upon, and in each 
case a judgment will be made by the editors on whether 


This policy was originally written for TOMS in 1975 by Editor-in- 
Chief John R. Rice, with Richard M. Heiberger and Charles L. 
Lawson, who made substantial contributions to the formulation of the 
policy, and with Edward Battiste, David C. Hoaglin, and Paul Velle- 
man, who made valuable suggestions. This policy now applies also to 
TOPLAS, in which the first algorithm was published in 1981. 
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a reasonable and useful level of transportability has been 
achieved. It is widely realized that, in general, high level 
language algorithms cannot yet be constructed to give 
top performance in a variety of environments. 

ACM publication normally consists of two parts: a 
description of the package and a critical review of it. 
Authors of a package will submit material for the first 
part and the editors will seek referee/reviewers for the 
second part. We note that a multitude of widely distrib- 
uted software packages already exist, some of excellent 
quality. We consider such packages to have already been 
published. Other packages may become widely distrib- 
uted in the future. Authors independent of the developers 
of these packages are invited to submit critical reviews 
of them. An author of a new package is expected to 
demonstrate the superiority of the new package over any 
existing packages. 


Specific Requirements 


The following guidelines for authors give information 
about the expected contents of papers to be printed in 
TOMS or TOPLAS, the nature of the packages to be 
distributed, and the material to be submitted for consid- 
eration by the editors. 

(1) The Descriptive Paper. The paper should contain 
a clear statement of goals, intended users, expected en- 
vironment, and the problem domain of the package. 
Then there should be a discussion of the main compo- 
nents and steps in the development of the package. This 
includes mathematical descriptions, general algorithm 
structure, testing and evaluation, documentation, pro- 
gramming, and portability. Interesting design questions 
should be discussed here. It is not expected that a com- 
plete mathematical derivation be given; rather one 
should give pertinent references. Descriptions of new 
techniques belong in an independent paper. The aim 
here is to give the reader a general and reasonably 
complete description without burdening him with the 
full details of documentation and techniques. Full details 
are available from the references and the ACM Algo- 
rithm Distribution Service. The paper should give some 
basic statistics about the package, e.g. length, examples 
of performance (memory usage, execution times), I/O 
requirements. 


xiv SOFTWARE PACKAGE POLICY 


(2) The Package. The ACM Algorithm Distribution 
Service makes three items available: the programs, user 
documentation, and internal documentation. All docu- 
mentation is incorporated into the program as machine- 
readable comments. A package must be of acceptable 
quality in all of the following aspects: user documenta- 
tion; internal documentation; ease of use; programming 
style; consistency of style, structure, and notation; basic 
algorithmic and mathematical techniques; adherence to 
language standards; ease of modification and transpor- 
tation; performance characteristics; overall structure and 
organization. 

(3) Material To Be Submitted. The material for an 
ACM software package should be submitted to the Al- 
gorithms Editor or to the Editor-in-Chief of TOMS or of 
TOPLAS and should consist of the following items: 


—-machine readable form of package 

—descriptive paper (three copies) 

documentation (user and internal—probably part of 
first item) 

—drivers for examples and testing 

—test and evaluation results (listings from actual runs, 
summaries, etc.). 


The drivers submitted should exercise all the modules 
in the package. The test and evaluation results must 
support the claim of superiority over existing packages; 
a separate discussion of this aspect will probably be 
required. 


It must be emphasized that finding referees for soft- 
ware packages is likely to be difficult, and that if com- 
petent referees cannot be found it will be necessary to 
reject the manuscript. Authors will improve their chances 
of finding willing referees if they submit their material 
in a neat and well organized form. All computer tests 
submitted should be carefully annotated so that the 
referee can easily determine the nature of the test, the 
test data used, the expected results, and the results pro- 
duced by the package. 

(4) The Critical Review. This paper will analyze the 
strengths and weaknesses of the package in an objective 
manner. It may include extensive discussions of only a 
few aspects of the package if they are of sufficient interest 
(particularly for already existing packages). Critical re- 
views of widely disseminated packages not published in 
either TOMS or TOPLAS must contain basic informa- 
tion about their distribution, listings, and maintenance 
support. 


Editorial Comment 


It is clear that the preparation of a publishable software 
package is a task well beyond the usual technical publi- 
cation. The critical review part of publication is a way in 
which referees can obtain suitable recognition for the 
substantial effort involved in a thorough evaluation of a 
package. 
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QUADRATURE [D1]. 


Laurie, D.P. Algorithm 584: CUBTRI—Automatic cubature over 
a triangle. (Fortran) ACM Trans. Math. Softw. 8, 2 (June 1982), 
210--218. 


Robinson, |., and deDoncker, E. Algorithm 45: Automatic 
computation of improper integrals over a bounded or 
unbounded planar region. (Fortran) Computing 27, 3 (1981), 
253-284. 


INTEGRAL EQUATIONS [D5] 


Piessens, R. Algorithm 113: Inversion of the Laplace transform 
(ALGOL) Computer Journal 25, 2 (May 1982), 278-282. 


INTERPOLATION [E1] 


Brezinski, C. Algorithm 585: A subroutine for the general 
interpolation and extrapolation problems. (Fortran) ACM Trans. 
Math. Softw. 8, 3 (Sept. 1982), 290-301. 


Hanson, R.J. Remark on Algorithm 507: Procedures for quintic 
natural spline interpolation. ACM Trans. Math. Softw. 8, 3 
(Sept. 1982), 334. 


MATRIX OPERATIONS [F1] 


Chan, T.F. Algorithm 581: An improved algorithm for computing 
the singular value decomposition. (Fortran) ACM Trans. Math. 
Softw. 8, 1 (March 1982), 84-88. 


Lewis, J.G. Algorithm 582: The Gibbs-Poole-Stockmeyer and 
Gibbs-King algorithms for reordering sparse matrices. (Fortran) 
ACM Trans. Math. Softw. 8, 2 (June 1982), 190-194. 


Monch, W. Algorithm 46: Iterative refinement of approximations 
to a generalized inverse of a matrix. (ALGOL) Computer 28, 1 
(1982), 79-87. 


Dodson, D.S., and Grimes, R.G. Remark on Algorithm 539: 
Basic linear algebra subprograms for Fortran Usage. ACM 
Trans. Math. Softw. 8, 4 (Dec. 1982), 403--404. 


Lewis, J. G. Remark on Algorithms 508 and 509: Matrix 
bandwidth and profile reduction; A hybrid profile reduction 
algorithm. ACM Trans. Math Softw. 8, 2 (June 1982), 221. 


EIGENVALUES AND EIGENVECTORS OF MATRICES [F2] 


Dongarra, J.J. Algorithm 589: SICEDR: A Fortran subroutine for 
improving the accuracy of computed matrix eigenvalues. ACM 
Trans. Math. Softw. 8, 4 (Dec. 1982), 371-375. 


van Dooren, P. Algorithm 590: DSUBSP and EXCHQzZ: Fortran 
subroutines for computing deflating subspaces with specified 
spectrum. ACM Trans. Math. Softw. 8, 4 (Dec. 1982), 
376-382. 


Garbow, B.S. Remark on Algorithm 535: The QZ algorithm to 


solve the generalized eigenvalue problem. ACM Trans. Math. 
Softw. 8, 4 (Dec. 1982), 402. 


Flamm, D.S., and Walker, R.A. Remark on Algorithm 506. 
HQR3 and EXCHNG: Fortran subroutines for calculating and 
ordering the eigenvalues of a real upper Hessenberg matrix. 
ACM Trans. Math. Softw. 8, 2 (June 1982), 219-220. 


SIMULTANEOUS LINEAR EQUATIONS [F4] 


Paige, C.C., and Saunders, M.A. Algorithm 583: LSQR— 
Sparse linear equations and least squares problems. (Fortran) 
ACM Trans. Math. Softw. 8, 2 (June 1982), 195-209. 
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Kincaid, D.R., Respess, J.R., and Young, D.M. Algorithm 586: 
ITPACK 2C—A Fortran package for solving large sparse linear 
systems by adaptive accelerated iterative methods. (Fortran) 
ACM Trans. Math. Softw. 8, 3 (Sept. 1982), 302-322. 


Hanson, R.J., and Haskell, K.H. Algorithm 587: Two algorithms 
for the linearly constrained least squares problem. (Fortran) 
ACM Trans. Math. Softw. 8, 3 (Sept. 1982), 323-333. 


ORTHOGONALIZATION [F5] 


Buckley, A. Remark on Algorithm 580: GRUP: A set of Fortran 
routines for updating QR factorizations. ACM Trans. Math. 
Softw. 8, 4 (Dec. 1982), 405. 


SIMPLE CALCULATIONS ON STATISTICAL DATA [G1] 


Hemmerle, W.J. Algorithm 591: A comprehensive, matrix-free 
algorithm for analysis of variance. ACM Trans. Math. Softw. 8, 4 
(Dec. 1982), 403-404. 


Frome, E.L., Algorithm 171: Fischer’s exact variance test for 
the Poisson distributions. (Fortran) Applied Statistics 31, 1 
(1982), 67-71. 


MacKenzie, G., and O’Flaherty, M. Algorithm 173: Direct design 
matrix generation for balanced factorial experiments. (Fortran) 
Applied Statistics 31, 1 (1982), 74-80. 


Schwertman, N.C. Algorithm 174: Multivariate multisample non- 
parametric tests. (Fortran) Applied Statistics 31, 1 (1982), 
80-85. 


Laurie, D.P. Algorithm 175: Cramer-Wold factorization. (Fortran) 
Applied Statistics 31, 1 (1982), 86-93. 


Silverman, B.W. Algorithm 176: Kernel density estimation using 
the Fast Fourier Transform. (Fortran) Applied Statistics 31, 1 
(1982), 93-99. 


RANDON NUMBER GENERATORS [G5] 


Tracht, A.E. Remark on Algorithm 334: Normal random 
deviates. ACM Trans. Math. Softw. 8, 1 (March 1982), 89. 


OPERATIONS RESEARCH, GRAPH STRUCTURES [H] 


Carpanto, G., and Toth, P. Algorithm 44: Algorithm for the 
solution of the bottleneck assignment problem. (Fortran) 
Computing 27, 2 (1981), 179-187. 


Fayard, D., and Plateau, G. Algorithm 47: An algorithm for the 
solution of 0-1 knapsack problem. (Fortran) Computing 28, 3 
(1982), 269-287. 


APPROXIMATION OF SPECIAL FUNCTIONS [S17] 


Anderson, W.L. Algorithm 588: Fast Hankel transforms using 
related and lagged convolutions. ACM Trans. Math. Softw. 8, 4 
(Dec. 1982), 369-370. 


ALL OTHERS [Z] 


O'Flaherty, M., and MacKenzie, G. Algorithm 172: Direct 
simulation of nested Fortran DO-loops. (Fortran) Applied 
Statistics 31, 1 (1982), 71-74. 


Frost, R.A. Algorithm 112: Dumping the index of a dynamic 
hash table. (ALGOL 68-R) Computer Journal 24, 4 (Nov. 1981), 
383-384. 
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REAL ARITHMETIC; NUMBER THEORY [A1]. 
OPERATIONS ON POLYNOMIALS AND POWER SERIES 
[C1] 


Lozier, D.W., and Smith, J.M. Algorithm 567: 
Extended-range arithmetic and normalized Legendre 
polynomials. (Fortran) ACM Trans. Math. Softw. 7, 1 
(March 1981), 141-146. 


ZEROS OF ONE OR MORE NONLINEAR EQUATIONS 
[CS] 


More, J.J., Garbow, B.S., and Hillstrom, K.E. Algorithm 
566: Fortran subroutines for testing unconstrained 
optimization software. (Fortran) ACM Trans. Math. 
Softw. 7, 1 (March 1981), 136-140. 


Incerti, S., Zirilli, F., and Parisi, V. Algorithm 111: A 
Fortran subroutine for solving systems of nonlinear, 
simultaneous equations. (Fortran) Computer Journal 
24, (1981), 87-91. 


ORDINARY DIFFERENTIAL EQUATIONS [D2] 


Ascher, U., Christiansen, J., and Russell, R.D. 
Algorithm 569: COLSYS—Collocation software for 
boundary-value ODE’s. (Fortran) ACM Trans. Math. 
Softw. 7, 2 (June 1981), 223-229. 


PARTIAL DIFFERENTIAL EQUATIONS [D3] 


Melgaard, D.K., and Sincovec, R.F. Algorithm 565: 
PDETWO/PSETM/GEARB—Solution of systems of 


two dimensional nonlinear partial differential equations. 


(Fortran) ACM Trans. Math. Softw. 7, 1 (March 1981), 
126-135. 


O'Leary, D.P., and Widlund, O. Algorithm 572: 
Solution of the Helmholtz equation for the Dirichlet 
problem on general bounded three-dimensional 
regions. (Fortran) ACM Trans. Math. Softw. 7, 2 (June 
1981), 239-246. 


DIFFERENTIATION [D4] 


Fornberg, B. Algorithm 579: CPSC: complex power 
series coefficients. (Fortran) ACM Trans. Math. Softw. 
7, 4 (Dec. 1981), 542-547. 


INTERPOLATION [E1] 
CURVE AND SURFACE FITTING [E2] 


McAllister, D.F., and Roulier, J.A. Algorithm 574: 
Shape-preserving osculatory quadratic splines. 
(Fortran) ACM Trans. Math. Softw. 7, 3 (Sept. 1981), 
384-386. 


Algorithms published elsewhere are included. A cumulative 
index to algorithms published in Communications, the ACM 
Transactions on Mathematical Software, and the ACM Transactions 
on Programming Languages and Systems from 1960 through 1980 
may be consulted in “Collected Algorithms from ACM,” which is a 
looseleaf collection of all algorithms, each with certifications and 
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MINIMIZING OR MAXIMIZING A FUNCTION [E4] 


More, J.J., Garbow, B.S., and Hillstrom, K.E. Algorithm 
566: Fortran subroutines for testing unconstrained 
optimization software. (Fortran) ACM Trans. Math. 
Softw. 7, 1 (March 1981), 136-140. 


Dennis, J.E., Jr., Gay, D.M., and Welsch, R.E. 
Algorithm 573: NL2SOL—An adaptive nonlinear least- 
squares algorithm. (Fortran) ACM Trans. Math. Softw. 
7, 3 (Sept. 1981), 369-383. 


MATRIX OPERATIONS, INCLUDING INVERSION [F1] 


Duff, 1.S. Algorithm 575: Permutations for a zero-free 
diagonal. (Fortran) ACM Trans. Math. Softw. 7, 3 
(Sept. 1981), 387-390. 


EIGENVALUES AND EIGENVECTORS OF MATRICES [F2] 


Stewart, W.J., and Jennings, A. Algorithm 570: 
LOPSI—A simultaneous iteration algorithm for real 
matrices. (Fortran) ACM Trans. Math. Softw. 7, 2 (June 
1981), 230-232. 


SIMULTANEOUS LINEAR EQUATIONS [F4] 


Barrodale, |., and Stuart, G.F. Algorithm 576: A Fortran 
program for solving Ax = b. (Fortran) ACM Trans. 
Math. Softw. 7, 3 (Sept. 1981), 391-397. 


DuCroz, J.J., Nugent, S.M., Reid, J.K., and Taylor, 
D.B. Algorithm 578: Solution of real linear equations in 
a paged virtual store. (Fortran) ACM Trans. Math. 
Softw. 7, 4 (Dec. 1981), 537-541. 


ORTHOGONALIZATION [F5] 


Buckley, A. Algorithm 580: QRUP; a set of Fortran 
routines for updating QR factorizations. (Fortran) ACM 
Trans. Math. Softw. 7, 4 (Dec. 1981), 548-549. 


SIMPLE CALCULATIONS ON STATISTICAL DATA [G1] 


Gardner, G., Harvey, A.C., and Phillips, G.D.A. 
Algorithm AS 154: An algorithm for exact maximum 
likelihood estimation of autoregressive-moving average 
models by means of Kajman filtering. (Fortran) Applied 
Statistics 29 (1980), 311-322. 


Davis, R. Algorithm AS 155: The distribution of a linear 
combination of x? random variables. (Algol) Applied 
Statistics 29 (1980), 323-333. 


Jones, B. Algorithm AS 156: Combining two 
component designs to form a row-and-column design. 
(Fortran) Applied Statistics 29 (1980), 334-337. 


Grafton, R. Algorithm AS 157: The runs-up and runs- 
down tests. (Fortran) Applied Statistics 30 (1981), 81- 
85. 


Cran, G. Algorithm AS 158: Calculation of the 
probabilities {P(|,k)} for the simply ordered alternative. 
(Fortran) Applied Statistics 30 (1981), 85-91. 


Patefield, W. Algorithm AS 159. An efficient method of 
generating random RxXC tables with given row and 
column totals. (Fortran) Applied Statistics 30 (1981), 
91-97. 


Lusbader, E., and Stodola, R. Algorithm AS 160: 
Partial and marginal association in contingency tables. 
(Fortran) Applied Statistics 30 (1981), 97-105. 


APPROXIMATION OF SPECIAL FUNCTIONS [S] 


Hill, G.W. Algorithm 571: Statistics for von Mises’ and 
Fischer's distributions of directions—/,(x)//o(x), 
1,.5(X)/los(x), and their inverses. (Fortran) ACM Trans. 
Math. Softw. 7, 2 (June 1981), 233-238. 


Carlson, B.C., and Notis, E.M. Algorithm 577: 
Algorithms for incomplete elliptic integrals. (Fortran) 
ACM Trans. Math. Softw. 7, 3 (Sept. 1981), 398-403. 


Hill, G.W. Remark on Algorithm 395: Student’s t- 
distribution. ACM Trans. Math. Softw. 7, 2 (June 
1981), 247-249. 


Hill, G.W. Remark on Algorithm 396: Student’s t- 
quantiles. ACM Trans. Math. Softw. 7, 2 (June 1981), 
250-251. 


Razaz, M., and Schonfelder, J.L. Remark on Algorithm 
498: Airy functions using Chebyshev series approxi- 
mations. ACM Trans. Math. Softw. 7, 3 (Sept. 1981), 
404-405. 


ALL OTHERS [Z] 


Hanson, D.R. Algorithm 568: PDS—A portable 
directory system. (Ratfor and Fortran) ACM Trans. 
Program. Lang. Syst. 3, 2 (April 1981), 162-167. 
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All Others 

Approximation of Special Functions 
Combinations and Permutations 
Compiling 

Complex Arithmetic 

Composite Input 

Computing Structure Simulation 
Convergence Acceleration 

Conversion and Scaling of Data 
Correlation and Regression Analysis 
Curve and Surface Fitting 

Data Conversion and Scaling 
Determinants 

Differential Equations, Ordinary 
Differential Equations, Partial 
Differentiation 

Eigenvalues and Eigenvectors of a Matrix 
Exponential and Logarithmic Functions 
Function Minimizing and Maximizing 
Graph Structures, Operations Research 
Hyperbolic Functions 
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Integral Equations 

Interpolation 

Inversion of a Matrix 

Linear Equations, Simultaneous 
Logarithmic and Exponential Functions 
Matrix Eigenvalues and Eigenvectors 
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Matrix, Determinant of 
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Minimizing a Function 

Nonlinear Equations, Zeroes of 
Number Theory 
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Physics Applications 
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Roots and Powers 
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Simultaneous Linear Equations 
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SIMULTANEOUS LINEAR EQUATIONS 
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REAL ARITHMETIC, NUMBER THEORY 


PARTITION FCNS. (MODULO D) 
RATIONAL INTERVAL FUNCTIONS (A) 
EUCLIDEAN ALGORITHM 

SIEVE OF ERATOSTHENES 


RANGE ARITHMETIC 
AUGMENTATLON 

COMPOSITIONS 

GENERALIZED ARITHMETIC 
PARTITIONS 

JACOBI SYMBOL 

PARTITIONS 

DIOPHANTINE EQUATION 

PRIME TWINS 

GREATEST COMMON DIVISOR 
RESTRICTED PARTITIONS OF N 
PARTITION GENERATOR 

MAP OF PARTITIONS INTO INTEGERS 
SYMMETRIC GROUP CHARACTERS 
PRIME NUMBER GENERATOR 1 


PRIME NUMBER GENERATOR 2 
MULTI-DIMENSION PARTITION GEN. 
PRIME NUMBER GENERATOR 


7 PRIME NUMBER GENERATOR 


PARTITIONS IN NATURAL ORDER 
COMPLEX PRIMES 

RESTRICTED PARTITIONS GEN. 
DOUBLY RESTRICTED PARTITIONS 
GCD OF N INTEGERS & MLTPLRS(F) 
COMPLEX PRIMES 

CIRCULAR INTEGER PARTITION 
MULTIPLY-RESTRICTED PARTITNS(F) 
ARITH. OVER FINITE FIELD (A) 
SUM OF FACTORS OF N (SUMFAC) 
RATIONAL APPROX. OF REAL NO. 
PARTITIONING INTEGERS, N DIM 
FACTORING ALGORITHM 

INTERVAL ARITHMETIC (A) 


MULTIPLE INTEGER ARITHMETIC (A) 
SIMULATION OF INTERVAL ARITH 
APPROX OF SUMS OF MANY TERMS(A) 
EXTENSION OF ARITH. PRECISION 
MULTIPLE-PRECISION ARITHMETIC (F) 
MULTIPLE-PRECISION ARITHMETIC (F) 
TC SHORTEN SEQ OF INTEGER SETS 


COMPLEX ARITHMETIC 


COMPLEX ARITHMETIC 

COMPLEX DIVIDE 

COMPLEX ARITHMETIC 

COMPLEX ABS, SQRT 
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COMPLEX INTERVAL ARITHMETIC (F) 


TRIG AND INVERSE TRIG FUNCTIONS 


ARCCOS (Z) 
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ARCTAN(Z) 

ARCCOSSIN 

ELEMENTARY FCNS.BY CONT. FRACT. 
ARCTAN(Z) 

FOURIER TRANSFORM 

COS FCN.BY CHEBYSHEV EXPANSION 
SIN FCN. BY CHEBYSHEV EXPANSION 
ARCSIN BY CHEBYSHEV EXPANSION 
ARCTAN BY CHEBYSHEV EXPANSION 
TAN FCN.BY CHEBYSHEV EXPANSION 
EVALUATION OF A TRIG POLY 


HYPERBOLIC FUNCTIONS 
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SINH (X) 


EXPONENTIAL AND LOGARITHMIC FUNCTIONS 


NIELSENS GENERALIZED POLYLOG 
EXP(Z),Z COMPLEX 
LOG(Z),Z COMPLEX 
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ROOTS AND POWERS 
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CA, 13-70(447) , 16-73(257 eS 
CA, 13-76(693) , 13-70(695 eo 
CA, 14-71(48) a 
CA, 16-73(379) es 
CA, 16-73 (699) 2 
CJ, 9-67(416) 2 
CJ, 11-68 (347) ,12-69(293 C2 
CJ, 13-70(282) C2 
CJ, 14-71(166) 2 
CJ, 14-71(447), 15-72(285 C2 
17-74 (379) C2 
CJ, 15-72(281) c2 
CP, 5-70(377) C2 
cP, 12-74(323) C2 
NM, 18-71(224) 
TO, 4-78(71) 
TO, 4-78(71),5-79() c3 
ZM, 11-70(357) 
c5 
C5 
BT, 2-62 (233) C5 
CA, 5-62 (435) cS 
CA, 6-63 (386) 5 
CA, 10-67 (665) cs 
CJ, 1-67 (112), 10-67 (208 C5 
CJ, 18-75(83) c5 
C5 
C5 
BT, 2~62(236) oF 
BI, 2-62(236) ve 
BT, 2-62(236) cs 
CA, 6-63 (519) , 8-65 (194) Cs 
CA, 7-64 (296) , 12-69 (692) f 
CA, 7-64 (546) ee 
CC, 2-71(127) a 
NM, 4-62(411), 7-65(195) as 
NM, 4-62(411), 7-65(194) Pe 
NM, 4-62(412) ce 
NM, 4-62 (412) ee 
NM, 4-62 (412) , 7-65(195) ee 
2M, 11-70( 353) C5 
cs 
C5 
BT, 2-62(235) C5 
BT, 2-62(235) cS 
cS 
cs 
BT, 10-70(38) i 
CA, 4-61(178) , 5-62(347) re 
CA, 4-61 (179) , 5-62(347), a 
5-62(391) , 7-64 (485) c5 
CA, 7-64 (669) , 8-65 (279) a 
Se PeER CS 
NM, 4-62 (411) 
C5 
cS 
c5 
CA, 4-61(180) ,4-61(322) c5 
CA, 5-62 (388) , 5-62(557) 
CA, 6~63 (388) 
C6 
C6 
CA, 3-60(604) C6 
CA, 5-62(551) C6 
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EXPONENTIATE POWER SERIES 
EXPONENTIATE POWER SERIES 


REVERT POWER SERIES 

SOLN. OF EQNS.BY REVERSION 
SYMMETRIC POLYNOMIALS 

POLY.AND DERIV.BY HORNER SCHEME 
CHEBYSHEV SERIES (F) 

EVALUATION OF CONTINUED FRACTNS 
CALCULATION OF GRAM POLYS 


AIRY FNS USING CHEPYSHEV SERIES APPR. (F) 


ZEROS OF POLYNOMIALS 


LEHMERS METHOD 
ROTATING-CROSS METHOD 
NEWTON METHOD (A) 
BAIRSTOW 


BAIRSTOW-NEWTON 


RESULTANT METHOD 
RATIONAL ROOTS-INTEGER COEFF. 


RATIONAL ROOTS-INTEGER COEFF. 


NEWTON-MAEHLY 

BOUNDS ON ZEROS 

MODIFIED GRAEFFE METHOD 

REAL SIMPLE ROOTS 

ROOTS OF LOW ORDER POLY EQNS 
RT-SQUARING AND RESULTANT METH. 
ZEROS OF COMPLEX POLYNOMIAL (F) 
ROOTS OF A POLYNOMIAL (F) 
BAIRSTOW 


SOLUTION OF POLY. TO MACH. PRECISION (A) 


ZEROES OF POLYNOMIALS 

APP VALUES OF POLY ROOTS 

PL/1 PROG FOR LEHMERS METHOD 
ZEROS OF A REAL POLYNOMIAL (F) 
POLY DECOMP INTO QUAD FACTORS 
HOMOGRAPHIC TRANSF OF ZEROS 
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CA, 5-62 (553) , 6~63(390) 
CA, 6-63 (104) , 6-63(390), 
6-63(522) 

CA, 6-63 (388) , 6-63 (745) 
CA, 9-66(11) 

CA, 10-67(450), L1-68 (272 
CA, 11-68 (633), 12-69(39) 
CA, 16-73(254) , 18-75(276 
Ch, 9-XX (327) 

CJ, 9-66(323) 

TO, 1-75(372) 


BT, 4-64 (255) 

BT, 7-67(244) 

BT, 13-73(71) 

CA, 3-60(74) , 3-60( 354), 
4-61(1065), 4-61(153), 
4~61(181) 

CA, 3-60(643), 4-61(238), 
5-62(5@), 10-67 (293) 

CA, 4-61(236) 

CA, 5~62 (48) ,5-62(392), 
5-62 (439) 

CA, 5-62 (97) ,5-62(168), 
5-62(440) 

CA, 5-62 (387), 6-63( 389) 
CA, 6-63 (311) 

CA, 8~65 (379) , 9-66 (687) 
CA, 9+66(273) 

CA, 11-68(269) 

CA, 11-68(779) ,12-69(281 
CA, 15-72(97) ,17-74(157) 
CA, 15-72(776) ,16-73(579 
CJ, 10-67 (207) 

CJ, 18-75(258) 

CP, 5-70(199) 

CP, 6-76¢ 

MC, 23-69(829) 

TO, 1-75(178) 

YM, 11-70(215) 
ZM,11-76(229) 

1963 (364) 


EXPLICIT TIME INTEG., PARABOLIC EQNS (F) TO, 6-80(236) 


ZEROS OF ONE OR MORE NON-LINEAR EQUATIONS 


ZEROS BY INTERP. OR BISECTION 
MODIFIED REGULA FALSI METHOD 
ZEROS OF ENTIRE FUNCTIONS (A) 
HIGH ORDER REGULA FALSI (A) 
SOLVE F(X)=@ 


ROOT ISOLATION USING FUNCTION VALS (F) 


REGULA FALSI 


BISECTION 
REGULA FALSI 


REAL ZEROS 


REGULA FALSI 


SOLN. OF SIMULTANEOUS NONLINEAR EQNS (F) 
NONLINEAR EQUATIONS WITH A PARAMETER (F) 


MULLERS METHOD 

N FUNCTIONAL EQNS.IN N UNKNOWNS 
DAMPED TAYLR SERIES~NONLIN. SYS. 
NON-LINEAR SYSTEM 

COMPLEX ROOT FINDING 

SOLVE NONLINEAR SYSTEM OF EQS. 
TAYLOR COEFF OF ANALYTIC FUN 
SOLUTION OF W*EXP(W)=X (F) 
SYSTEMS OF NONLINEAR EQUATIONS (F) 


FIXED POINTS OR ZEROS OF C2 MAPS (F) 


SOLN OF NONLINEAR EQUATIONS 
BRACKETING TECHNIQUE 

ALG WITH GUARANTEED CONVERGENCE 
ROOT F(T)=@ WITH ERROR BOUNDS 
ROOTS OF FCNS. WITH ERROR BOUND 
SOLN. FIN.DIM. NONLINEAR SYSTEM 
ENCLOSING ZEROS OF A FUNCTION 
SYSTEMS OF NONLINEAR EQUATIONS 
REAL ROOTS IN AN INTERVAL (A) 
SYSTEM OF NON-LINEAR ALG EQ (F) 
SPARSE SYSTEM NON-LINEAR EQ (F) 
BROUWER DEGREE IN R*¥R_ (A) 


SYSTEMATIC SEARCH IN HIGH DIM. SETS (F) 


BT, 3-63(205) 

BT, 11~71(168) 

BT, 13-73(8) 

BT, 13-73(253) 
BT,17-77(179) 
BT,18-78(311) 

CA, 3-60(74) ,3-60(354), 
3-60(475) , 4-61(153) 

CA, 3-60(174) , 4-61 (153) 
CA, 3-60(475) , 3-60(602), 
4-61(153) 

CA, 3~60(6@2) ,4-61(153), 
4-61(154) 

CA, 3-60(603) ,4-61(153) 
CP, 22-79(282) 

CP, 23-80(85) 

CA, 6-63(442) ,11-68(12) 
CA, 16-67 (726) , 12-69 (38) 
CA, 10-67(726) ,12~69(513 
CA, 1@-67(728), 14-71 (493 
CA, 12-69 (686) 

CA, 13-790(259) 

CA, 14-71(669) 

CA, 16~73(123),17-74 (225 
TO, 6-80(240) 

TO, 6-80(252) 

CJ, 12-69(496) ,13~790(219 
CJ,13-70(101) 
CJ,14-71(422) 

CP, 2-67(231) 

CP, 4-69(197) 

CP, 5~70(84) 

CP, 5~70(356) 

CP, 8~71(41) 

CP, 9~72(327) 

HA, AERE-R5947 

HA, AERE-R7293 

MC, 27-73(133) 

SN, 14-77 (296) 


DEP. SOL. OF NONLIN. SYS. ON A PARAM. (F) TO, 2~76(98) 


SUMMATION OF SERIES, CONVERGENCE ACCELERATION 
COMPLX DISCRETE FAST FOURIER TRANSFRM(F) AS, 24-75(153) 


REAL FAST FOURIER TRANSFORM (F) 
CHIRP DISCRETE FOURIER TRANSF. (F) 


AS, 25-76(166) 
AS, 26~-77(351) 
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43 


FIND LIMIT OF SEQUENCE 
EPSILON ALGORITHM 

LOW ROUND-OFF SUMMATION METHOD 
EULER; SUM 

FOURIER SERIES SUMMATION 
FOURIER SERIES APPROXIMATION 


EPSILON ALGORITHM 
FOURIER COEFFICIENTS 

CHEBYSHEV SERIES COEFFICIENTS 
HARMONIC ANAL-SYM DISTR DATA 
FAST FOURIER TRANSFORM 

FAST FOURIER WITH ARB. FACTORS 
CONVOLUTION BASED ON FFT 
SUMMATION WITH ARB. PRECISION 
LEGENDRE SERIES COEFFS (F) 
EPSILON ALG.-CONTINUED FRACTNS 
SUM FOURIER SERIES 

COMPLEX FOURIER ANALYSIS 
GENZD. EULER TRANSFORMATION 
UNSCRAMBLE FAST FOURIER TRANS. 
CONVERGENCE ACCELERATION (F) 
EPSILON ALGORITHM 

OPTIMIZED MASS STORAGE FFT (F) 


; QUADRATURE 
AUX FN FOR DISTR. INTEGRALS (F) 
ADAPTIVE SIMPSONS RULE 

ROMBERG METHOD 

QUADRATURE 

MULTIPLE INTEGRAL 


ROMBERG METHOD 
SIMPSONS RULE 


COMPLEX LINE INTEGRAL 
SIMPSQNS RULE 
GAUSSIAN COEFFICIENTS 
ADAPTIVE SIMPSON 


MULTIPLE INTEGRAL 

ADAPTIVE SIMPSON 
ADAPTIVE,MULTIPLE INTEGRAL 
MULTIPLE INTEG.-SIMPSONS RULE 
HAVIE : INTEGRATOR 


CHEBYSHEV QUADRATURE 


f GREGORY QUADRATURE COEFFICIENTS 


ROMBERG QUADRATURE COEFFICIENTS 
ADAPTEVE QUAD.-RANDM PANEL SIZE 
GAUSSIAN QUADRATURE. FORMULAS 


MODIFIED ROMBERG QUADRATURE 


FILON :QUADRATURE 

ADAPTIVE SIMPSON QUADRATURE 
MODIFIED HAVIE INTEGRATION (F) 
WEIGHTS OF INTERPOLATION QUAD 
FOURIER INTEGRAL (F) 


CLENSHAW-CURTIS QUADRATURE 
CLENSHAW-~CURTIS QUADRATURE (F) 
FOURIER COSINE INTEGRAL 
PRODUCT TYPE TRAPEZOIDAL RULE 
PRODUCT TYPE SIMPSON RULE 
GAUSS=LEGENDRE-SIMPSON RULE 
GAUSS~LEGENDRE~SIMPSON RULE 
MULTI=DIM MONTE CARLO QUAD. (A) 
GAUSS QUAD FORM BRMWCH'S INT(F) 
INTEGR. OVER FINITE INTERVAL(F) 
MONTE ‘CARLO QUADRATURE 

MSR ANALYSIS INTEGRAL 
CLENSHAW-CURTIS QUADRATURE 


CHEBYSHEV SERIES FOR OSCILL. INTEC. 


CAUTIOUS ADAPTIVE QUADRATURE (A) 
QUADRATURE WITH ERROR BOUNDS 
FOUR-DIM. ROMBERG INTEGRATION 
INT OF HIGHLY OSCILLATORY FN(F) 
AUTO. ‘COMT. 
WILF-QUADRATURE (F) 

INTEGRATION OVER A TRIANGLE (F) 
NUMERICAL INTEGRATION (F) 
CALC. OF GAUSS QUAD. RULES 
OPTIMAL ADDIT'N OF ABSCISSAS(F) 
ROMBERG METHOD 

QUADRATURE BY EXTRAPOLATION 
CENTROID METHOD INTEGRATION 
GUASSIAN QUADRATURE 


OF SINGULAR INTEG. (F) 


BT, 1-61(64) 

BT, 2-62 (240) 

BT, 11-71(271) 

CA, 3-66(311) , 6-63 (663) 
CA, 5~62(513), 7-64 (421) 
CA, 6-63(163) , 6-63(521), 
6-63 (618) 

CA, 6-63 (662) , 7-64 (297) 
CA, 8-65(279) ,12-69(636) 
CA, 9-66(86) 

CA, 11-68(114) 

CA, 11-68(773) 

CA, 11-68(776) ,12-69(187 
CA, 12-69(179) ,12-69(566 
CA, 13~76(570) , 15-72 (468 
CA, 17-74(25) 

CH, 9~XX (327) 

CJ, 6-63 (248) 

CJ, 10-68 (414) ,11-68(115 
CJ, 14-71(437) 

CP, 3-68 (334) 

CP, 21-78(87) 

NM, 6-64 (22) 

TO, 5-79( ) 


AS, 17-68(190) ,22-73(428 
BT, 1-61(290) 

BT, 4~64 (58) 

CA, 3-60(74) 

CA, 4-61 (106) , 6-63(69), 
11+68 (826) 

CA, 4-61(255) , 5-62(168), 
5-62(281) , 7-64 (420) 

CA, 5-62 (208) , 5-62(392), 
5~62(440) , 5-62(557) 

CA, 5-62(345) 

CA, 5~62(347) 

CA, 5-62(510) 

CA, 5-62 (604) , 6-63(167), 
8-65(171) 

CA, 5-62(604) , 7-64(296) 
CA, 6-63(315) , 7-64(244) 
CA, 6~63(443) 

CA, 7-64 (348) , 13-76(512) 
CA, 8-65( 381), 9-66(795), 
9-66(871) 

CA, 9~66 (270) , 9-66(434), 
10-67 (294) , 10-67 (666) 
CA, 9-66(271) 

CA, 9-66 (271), 10-67(188) 
CA, 16-67 (373) 

CA, 11-68(432) ,12-69(280 
13+70(512) 

CA, 12-69(324) ,13-70(374 
13-70(263) , 13-76 (449) 
CA, 12-69(457) , 13-70(263 
CA, 13-70(260) , 15-72(107 
CA, 13-70(622) ,17~-74(324 
CA, 14-71(807) 

CA, 15-72(47) , 15-72(469) 
16-73(775) ,17-74 (324) 
CA, 15-72(353) 

CA, 15-72(353) , 5-79( 240) 
CA, 15-72(358) 

CA, 15-72(1670) 

CA, 15-72(1070) 

CA, 15-72(1071) 

CA, 15~72(1072) 

CA, 16-7349) 

CA, 16-73(486) 

CA, 16-73(694) 

CJ, 6-63(281) 

CJ, 13-70(207) ,14-71(215 
CJ, 15-72(141) 

CJ, 19-76(258) 

CJ, 21-78 (189) 

CP, 3-68 (47) 

CP, 9-72(45) 

CP, 13-74(183) 

CP, 17-76(265) 

cP, 81-77(271) 
CP,19-77(179) 

CP, 20-78 (363) 

MC, 23~69(221) 

MC, 28-74(344) 

NM, 6-64 (15) 

NM, 9-66 (274) 

NM, 16-71(343) 

NM, 18-72(465) 


EVAL. :IMPROPER INTEGRAL ON FINITE INT. (A)ZM, 15-76(141) 


RUNGE-KUTTA 
ZEROS OF 0.D.E. 
KUTTA-MERS ON 


SYSTEM 


DIFSUB FOR SOLUTION OF ODE 


ORDINARY DIFFERENTIAL EQUATIONS 


CA, 3-60(312) , 9-66(273) 
CA, 6~63(441) 

CA, 6~63 (737), 7-64 (585), 
9-66 (273) 

CA, 14-71(185) 
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504 
534 

47 


392 
460 


494 
527 
540 
541 
543 

48 


79 


368 
486 
486 
486 


97 


503 


16 


507 
526 
526 
547 


NR 


16 
46 


CUBIC SPLINE APPROXIMATION (F) 

SOLN. BY TAYLOR SERIES METHOD 

AUTOMATIC STEP CHANGE METHOD(A) 

INTEGR. SYSTEMS WITH DISCONTINUITIES (F) 
SOL. OF LIN. SECOND-ORDER DE(A) 
EXTRAPOLATION METHOD 

IST ORDER, AUTO. STEP CHANGE 

AUTO INTEG. OF FUNCTIONAL DIFF EQNS (F) 
GERK: GLOBAL ERROR EST. FOR ODES (F) 
STIFF DIFFERENTIAL EQUATIONS (F) 

SOL. 1-ST ORD. ODE'S IN CHEBY. SERIES(A) 
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cA, 16-73(635) 
CJ,14-71(243) 
CJ, 16-73(187) 
GJ,17-74 (275) 
CP, 13-74 (143) 
NM, 8-66 (10) 
NM, 14-79(317) 
T0,1-75(369) 
TO, 2-76 (200) 
TO, 4-78( ) 
2M, 15-76 (252) 


PARTIAL DIFFERENTIAL EQUATIONS 


CONFORMAL MAP-ELLIPSE TO CIRCLE 
SYSTEMS OF HYPERBOLIC PDE 

OPTIM. PARAM. ADI PROCEDURES (F) 
DELSQPHI,TWO-DIM POISSON EQ 
POISSON EQ IN CYLIN COORD 
FINITE DIFFERENCE METHODS (M) 
SOL OF LAPLACE'S EQUATION (F) 

A FAST CAUCHY-RIEMANN SOLVER (F) 
KERNEL FCN.IN BNDY.VALUE PROBS. 
ENDY.VALUE PROBS.-INTEGRAL OPRS 


METHOD OF CHARACTERISTICS FOR PDES (A) 
HYPERBOLIC DIFFERENTIAL EQUATIONS (A) 
HYPERBOLIC DIFF EQNS OF SECOND ORDER (A) 
SOLUTIONS OF SYSTEMS OF PDES (F) 
GENERALIZED MARCHING ALGORITHM (F) 
GENERAL COLLOCATION PDE SOFTWARE (F) 
SEPERABLE ELLIPTIC PDE'S (F) 

FAST SOLNS. OF HELMHOLT2-TYPE PDE'S (F) 
BOUND. VAL. PROB. FOR BIHARMONIC EQ. (A) 


DIFFERENTIATION 
INDICES IN FAA DI BRUNO FMLA(F) 
DIFFERENCE EXPRESSION COEFF. 
DIFFN.BY NEVILLES FORMULAS 


INTEGRAL EQUATIONS 
INVERSION OF LAPLACE TRANSFORM 
NUM. INVERSION OF LAPLACE TRANSFORM (A) 
NUM. INVERSION OF LAPLACE TRANSFORM (A) 


INVERSION OF ABEL'S INTEGRAL EQ. (F) 
CALCULATION OF GREEN'S FUNCTIONS (F) 
INTEGR OF UNEQ. SPACED DATA (A) 

SOLN. OF LINEAR FREDHOLM EQUATIONS (A) 
INVERSION LAPLACE TRANSFORM. 


FREDHOLM INTEGRAL EQUATIONS (A) 
FREDHOLM EQS. OF SECOND KIND (F) 


INTERPOLATION 
LOG-LINEAR FIT (F) 
POWER SUMS OF DEVIATIONS 
SMOOTH CURVE INTERPOLATION 
RATIONAL INTERP.-CONT. FRACT. 
AITKEN INTERPOLATION 
INTERPOLATION, DIFFN. , INTEGRN. 


CONFLUENT DIVIDED DIFFERENCES 
INTERPOLATION-DIVIDED DIFFCES. 
INTERPOLATION-DIVIDED DIFFCES. 
DLFFCES.AND DERIVS.-RECURSIVE 
LAGRANGE INTERPOLATION 

HERMITE INTERPOLATION 

INTERPOLATION IN A TABLE 

COEFF OF INTERPOLATION FORMULA 
INTERPOLATING NATURAL SPLINE(A) 
SMOOTH & INT. NATURAL SPLINE(A) 
AITKEN INTERPOLATION 

NEVILLE INTERPOLATION 

SPLINE INTERPOLN OF DEGREE 3 

QUINTIC SPLINES INTERPOLATION 
INTERPOLATE QUINTIC SPLINES 

CUBIC INTERPOLATION 

PERIODIC CUBIC SPLINE (A) 

PERIODIC SPLINE INTERPOLAT'N(A) 
DISCRETE APPROXIMATION (A) 

PERIODIC CUBIC SPLINE EQUIDIST. NODES(A) 
TWO-DIM. SMOOTH INTERPOLATION 

EXP. SPLINE INTERPOLATION 

HIGH DEGREE LIDSTONE SPLINES 

QUINTIC SPLINES 

TWO-DIM. EXPONENTIAL SPLINES 
TRIGONOMETRIC INTERPOLATION (A) 

CUBIC SPLINE APPROX. TO FN (F) 
COMPUTATION OF EXPONENTIAL SPLINE (A) 
NONLINEAR SPLINE FUNCTIONS (F) 
QUINTIC NATURAL SPLINE INTERPOLATION (F) 


BT, 2-62 (243) 
CA, 13-70(567) , 15-72 (167 
CA, 16-73(633) 

CC, 2-71(139) 

CC, 2=71(157) 

GC, 4-72 (82) 

HA, T.P.422 

MC, 33-79(585) 

MM, 3-61(209) 

NM, 7-65(56) 

225 (37)NO.24 

NM, 24-75 (331) 

NM, 28-77(121) 

MM, 34~86(217) 

10, 1-75(261) 

TO, 4-78(165) 

10, 5-79(326) 

TO, 5-79(352) ,5-79(365) 
T0,5-79() 

2M, 15-76(397) 


ET, 13~73(38) 
CA, 5-62 (97) , 6-63 (104) 
NM, 8~66 (462) 


CA, 13~70(47) ,13-70(624) 
CA, 17-74 (587) , 2-76(395) 
CA, 17-74(587) , 2-76(395) 
3-77(111) 

CC, 10-75(98) 

CC, 11-76(27) 

CJ, 15-72 (81) 

CJ, 20-77 (374) 

CP, 2-67(153) 

1965(933) 

NM, 34-80(125) 

TO, 2-76(196) 


AS, 21-72(218) , 25-76(193 
AS, 21-72(226) 

ET, 9~69(69) 

CA, 3-60(508) , 5-62(437) 
CA, 4-61 (497) , 5~62 (392) 
CA, 5-62 (96) , 5-62(348), 
6-63(446) , 6-63 (663) 

CA, 6-63 (164) , 6-63 (523) 
CA, 6-63(165) , 6-63(523) 
CA, 6-63(165) , 6-63 (523) 
CA, 6-63 (387) 

CA, 6-63 (616) 

CA, 6-63(617), 6-63(619) 
CA, 8-65 (602) 

CA, 14~71(806) 

CA, 16-73(763) 

CA, 17-74 (463) 

CJ, 9-66(211) 

CI, 9-66 (212) 

CJ, 12-69(198) ,12-69(409 
CJ, 12~69(292) ,13-70(115 
CJ, 13-70(437) 

CJ, 15-72 (80) 

CJ, 15-72(282) 

CJ, 15-72(283) ,17-74(91) 
CJ, 16~73(180) 

CJ, 18-75(183) 

CP, 4-69(180) , 8-71(200) 
CP, 4-69(230) 

CP, 7-71 (65) 

CP, 7-71(75) 

CP, 7-71(365) 

CP, 16-76 (319) 

HA, AERE-R7308 

NM, 35-80(81) 

SN, 14-77 (254) 

TO, 2-76(281) 


BIVARIATE INTERP. AND SURFACE FITTING (F)T0,4-78(161),5-79(242) 
BIVARIATE INTERP. AND SURFACE FITTING (F)1T0,4~78(161) 


CUBIC SPLINE INTERP. AND SMOOTHING (F) 
CALCULATION OF RATIONAL FUNCT 
BEST POLYNOMIAL FOR REMEZ ALG. 
INTERP. QUADRATIC SPLINE FUNCTION (A) 


TO, 6-80(92) 
2M, 11-70(101) 
2M, 12-71(107) 
2M, 15-76(245) 
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501 
501 
510 
514 
525 
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CURVE AND SURFACE FITTING 
TESTS OF FIT 
LI-NORM FIT OF A STRAIGHT LINE (F) 
L SUB P NORM FIT OF A STRAIGHT LINE (F) 
L SUB P NORM FIT OF A SRAIGHT LINE (F) 
CONTINUED FRACTION EXPANSION 
LEAST SQUARES BY ORTHOG. POLYN 


ECONOMIZATION 


ECONOMIZATION 
LEAST SQUARES WITH CONSTRAINTS 
CHEBYSHEV FIT 


SURFACE FIT 

SURFACE FIT 

LEAST SQUARES WITH CONSTRAINTS 
EXPONENTIAL CURVE FIT 
CONSTRAINED EXPONENTIAL FIT 
EXPONENTIAL CURVE FIT 

LEAST SQ.FIT-ORTHOG. POLYS. 


CHEBYSHEV CURVE FIT (REVISED) 
FIT DATA TO A*EXP(-B*X) 

FIT DATA TO A*COS(B*X+C) 
DISCRETE CHEBYCHEV CURVE FIT 
CHEBYSHEV APP OF CONT FUNCTION 
SMOOTH CURVE FITTING (F) 
INTERVAL LINEAR PROGRAMMING (F) 
BIVARIATE INTERPOLATION (F) 
BIVARIATE INTERPOLATION (F) 
CURVE FITTING USING SPLINES(F) 
G-SPLINES VIA FACTORIZATION (F) 
PARAMETER SEARCH 

MULTIVARIATE LEAST~SQUARES (F) 


OFF-DIAGONAL RATIONAL APPROXIMANTS (F,A) 


EXPONENTIAL FIT 

CURVE~FITTING PROGRAM (F) 

EXPONENTIALLY DAMPED LINEAR FIT 

AXIS INVARIANT PROCEDURE 

TRIGONOMETRIC CURVE FITTING 

GENERATION OF CHISHOLM APPROXIMANTS (A) 
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Gl 151 SPECTRAL EST, FOR BIVARIATE COUNTING (F) AS,29-80(214) ef ae ee ua 
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G2 87 POLYCHORIC EST. OF CORR. IN CONT. TAB. (F)AS, 24-75(272), 26-77(121 C6 28 PERMUTNS OF VECTORS-LEXIC ORDER CJ, 10-67(311) 
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IMPROVED CLUSTERING ALGORITHM 
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ALGORITHM 493 
Zeros of a Real Polynomial [C2] 


M.A. JENKINS 


Queen's University 


Key Words and Phrases: roots, zeros of a polynomial 
CR Categories: 5.15 
Language: Fortran 


DESCRIPTION 


The subroutine RPOLY is a Fortran program to find all the zeros of a real poly- 
nomial. The parameters are: 


OP double precision vector of coefficients in order of decreasing powers of 
the variable 

DEGREE integer degree of the polynomial 

ZEROR, double precision vectors of real and imaginary parts of the zeros found 

ZEROI | by the algorithm 

FAIL logical parameter which is true only if the leading coefficient is zero 
or if RPOLY has found fewer than degree zeros; in the latter case the 
degree is reset to the number of zeros found. 


The routine as written solves polynomials of degree up to 100; however, this can 
be modified by systematic changing of the declarations in the routines. 

The program is based on the three-stage algorithm described in Jenkins and 
Traub [1]. The algorithm generates a sequence of polynomials of degree one less 
than the degree of the given polynomial from which an approximation to a zero or 
a quadratic factor can be extracted. The first stage is linearly convergent and 
involves no shift of origin. It is used primarily to bias the decision making process 
in the second stage in favor of the zeros of small magnitude. The second stage is 
also linearly convergent and involves a double shift to a complex point and its 
conjugate. The shift point is chosen arbitrarily on a circle whose radius is less than 
the magnitude of all the zeros. In most cases, either the shift is closest to a real zero, 
or the pair of shift points are equidistant and closest to a pair of zeros. In the former 
case the second stage yields an approximation to the real zero and in the latter case 
it yields an approximation to the real quadratic factor. The third stage involves 
one of two variable-shift iterations, where the latest approximation(s) is used as the 
shift point(s) for the generation of the next polynomial. The choice of iteration is 
based on which case is observed in stage two. The convergence is superquadratic 
and usually requires only a few steps. The decision processes are made in a fail-safe 
manner. If the third stage is entered prematurely or the incorrect iteration is chosen, 
the second stage is resumed. If no convergence is observed in the second stage after 
a fixed number of steps, a new shift is chosen and the second stage is restarted with 
a higher fixed limit. The third-stage iterations are terminated when a stopping 
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criterion based on roundoff error analysis has been satisfied. The real zero or quad- 
ratic factor is removed by polynomial deflation and the algorithm is repeated on 
the reduced polynomial. 

The first statements of RPOLY set the following four constants which describe 
the floating-point arithmetic of the computer being used: 


ETA maximum relative representation error, which can be described as the 
smallest positive floating-point number such that 1 + ETA > 1 in 
floating-point arithmetic 

INFIN large floating-point number near the top of the range 

SMALNO small positive floating-point number near zero 

BASE exponent base for the floating-point number system. 


The program is written in a portable subset of standard Fortran. It has been 
successfully used on the Burroughs B6700 and the IBM 360/50. 

The program has been tested on a large number of polynomials, some chosen to 
test weaknesses common to zerofinding routines, others randomly generated by a 
number of techniques. 
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ALGORITHM 
SUBROUTINE RPOLY(OP, DEGREE, ZEROR, ZEROI, RPO 10 
* FAIL) RPO 28 
C FINDS THE ZEROS OF A REAL POLYNOMIAL RPO 38 
C OP - DOUBLE PRECISION VECTOR OF COEFFICIENTS IN RPO 40 
Cc ORDER OF DECREASING POWERS. RPO 5@ 
C DEGREE - INTEGER DEGREE OF POLYNOMIAL. RPO 68 
C ZEROR, ZEROI - OUTPUT DOUBLE PRECISION VECTORS OF RPO 78 
Cc REAL AND IMAGINARY PARTS OF THE RPO 80 
Cc ZEROS. RPO 90 
C FAIL - OUTPUT LOGICAL PARAMETER, TRUE ONLY IF RPO 108 
Cc LEADING COEFFICIENT IS ZERO OR IF RPOLY RPO 118 
Cc HAS FOUND FEWER THAN DEGREE ZEROS. RPO 128 
Cc IN THE LATTER CASE DEGREE IS RESET TO RPO 136 
Cc THE NUMBER OF ZEROS FOUND. RPO 148 
C TO CHANGE THE SIZE OF POLYNOMIALS WHICH CAN BE RPO 158 
C SOLVED, RESET THE DIMENSIONS OF THE ARRAYS IN THE RPO 168 
C COMMON AREA AND IN THE FOLLOWING DECLARATIONS. RPO 178 
C THE SUBROUTINE USES SINGLE PRECISION CALCULATIONS RPO 188 
C FOR SCALING, BOUNDS AND ERROR CALCULATIONS. ALL RPO 198 
C CALCULATIONS FOR THE ITERATIONS ARE DONE IN DOUBLE RPO 2886 
C PRECISION. RPO 2190 
COMMON /GLOBAL/ P, QP, K, QK, SVK, SR, SI, U, RPO 228 
* Vv, A, B, C, D, Al, A2, A3, A6, AT, E, F, G, RPO 230 
* H, SZR, SZI, LZR, LZI, ETA, ARE, MRE, N, NN RPO 248 
DOUBLE PRECISION P(101), QP(1@1), K(1@1), RPO 258 
* QK(181), SVK(1@1), SR, SI, U, V, A, B, C, D, RPO 268 
* Al, A2, A3, A6, A7, E, F, G, H, SZR, SZI, RPO 278 
* LZR, LZiI RPO 288 
REAL ETA, ARE, MRE RPO 298 
INTEGER N, NN RPO 368 
DOUBLE PRECISION OP(161), TEMP(191), RPO 318 
* ZEROR(100), ZEROI(166), T, AA, BB, CC, DABS, RPO 328 
* FACTOR RPO 338 
REAL PT(1@1), LO, MAX, MIN, XX, ‘YY, COSR, RPO 348 
* SINR, XXX, X, SC, BND, XM, FF, DF, DX, INFIN, RPO 358 
* SMALNO, BASE RPO 360 
INTEGER DEGREE, CNT, NZ, I, J, JJ, NM1 RPO 370 
LOGICAL FAIL, ZEROK RPO 388 
C THE FOLLOWING STATEMENTS SET MACHINE CONSTANTS USED RPO 390 
C IN VARIOUS PARTS OF THE PROGRAM. THE MEANING OF THE RPO 480 
C FOUR CONSTANTS ARE... RPO 418 
C ETA THE MAXIMUM RELATIVE REPRESENTATION ERROR RPO 420 
Cc WHICH CAN BE DESCRIBED AS THE SMALLEST RPO 4380 
Cc POSITIVE FLOATING POINT NUMBER SUCH THAT RPO 448 
Cc 1.D8+ETA IS GREATER THAN 1. RPO 458 
C INFINY THE LARGEST FLOATING~POINT NUMBER. RPO 460 
C SMALNO THE SMALLEST POSITIVE FLOATING-POINT NUMBER RPO 479 
Cc IF THE EXPONENT RANGE DIFFERS IN SINGLE AND RPO 4890 
Cc DOUBLE PRECISION THEN SMALNO AND INFIN RPO 498 
Cc SHOULD INDICATE THE SMALLER RANGE. RPO 568 
C BASE THE BASE OF THE FLOATING-POINT NUMBER RPO 5180 
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SYSTEM USED. 
THE VALUES BELOW CORRESPOND TO THE BURROUGHS B670@ 
BASE = 8. 
ETA = .5*BASE** (1-26) 
INFIN = 4.3E68 
SMALNO = 1.@E-45 
ARE AND MRE REFER TO THE UNIT ERROR IN + AND * 
RESPECTIVELY. THEY ARE ASSUMED TO BE THE SAME AS 
ETA. 
ARE ETA 
MRE ETA 
LO = SMALNO/ETA 
INITIALIZATION OF CONSTANTS FOR SHIFT ROTATION 
XX = .707180678 


YY = -XX 

COSR = -.869756474 
SINR = .997564@5 
FAIL = .FALSE. 

N = DEGREE 

NN =N+1 


ALGORITHM FAILS IF THE LEADING COEFFICIENT IS ZERO. 
IF (OP(1).NE.8.D@) GO TO 18 
FAIL = .TRUE. 
DEGREE = @ 
RETURN 

REMOVE THE ZEROS AT THE ORIGIN IF ANY 

1@ IF (OP(NN).NE.@.@D@) GO TO 298 

J = DEGREE - N +1 


ZEROR(J) = @.D@ 
ZEROI (J) = 6.Dd 
NN = NN - 1 
N=N-1 

GO TO 10 


MAKE A COPY OF THE COEFFICIENTS 
28 DO 3@ I=1,NN 
P(I) = OP(I) 
3@ CONTINUE 
START THE ALGORITHM FOR ONE ZERO 
40 IF (N.GT.2) GO TO 66 
IF (N.LT.1) RETURN 
CALCULATE THE FINAL ZERO OR PAIR OF ZEROS 
IF (N.EQ.2) GO TO 56 
ZEROR(DEGREE) = -P(2)/P(1) 
ZEROI (DEGREE) ®.6D9 
RETURN 
50 CALL QUAD(P(1), P(2), P(3), ZEROR(DEGREE-1), 
* ZEROI(DEGREE-1), ZEROR(DEGREE), ZEROI (DEGREE) ) 
RETURN 
FIND LARGEST AND SMALLEST MODULI OF ‘COEFFICIENTS. 
60 MAX = Q. 
MIN = INFIN 
DO 70 I=1,NN 
X = ABS(SNGL(P(I))) 
IF (X.GT.MAX) MAX = X 
IF (X.NE.@. .AND. X.LT.MIN) MIN = X 
70 CONTINUE 
SCALE IF THERE ARE LARGE OR VERY SMALL COEFFICIENTS 
COMPUTES A SCALE FACTOR TO MULTIPLY THE 
COEFFICIENTS OF THE POLYNOMIAL. THE SCALING IS DONE 
TO AVOID OVERFLOW AND TO AVOID UNDETECTED UNDERFLOW 
INTERFERING WITH THE CONVERGENCE CRITERION. 
THE FACTOR IS A POWER OF THE BASE 
SC = LO/MIN 
IF (SC.GT.1.9) GO TO 86 
IF (MAX.LT.19.) GO TO 118 
IF (SC.EQ.0.) SC = SMALNO 
GO TO 96 
80 IF (INFIN/SC.LT.MAX) GO TO 11@ 
99 L = ALOG(SC)/ALOG(BASE) + .5 
FACTOR = (BASE*1.6D@) **L 
IF (FACTOR.EQ.1.D@) GO TO 116 
DO 100 I=1,NN 
P(I) = FACTOR*P (I) 
10@ CONTINUE 
COMPUTE LOWER BOUND ON MODULI OF ZEROS. 
11®@ DO 12@ I=1,NN 


PT(I) = ABS(SNGL(P(I))) 
128 CONTINUE 
PT(NN) = -PT(NN) 


COMPUTE UPPER ESTIMATE OF BOUND 
X = EXP((ALOG(-PT(NN) )-ALOG(PT(1))) /FLOAT(N) ) 
IF (PT(N).EQ.@.) GO TO 138 
IF NEWTON STEP AT THE ORIGIN IS BETTER, USE IT. 
XM = -PT(NN)/PT(N) 
IF (XM.LT.X) X = XM 
CHOP THE INTERVAL (@,X) UNTIL FF .LE. @ 
130 XM = X*.1 
FF = PT(1) 
DO 148 I=2,NN 
FF = FF*XM + PT(TI) 
149 CONTINUE 
IF (FF.LE.6.) GO TO 156 
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X = XM 
GO TO 138 
15@ DX = X 


DO NEWTON ITERATION UNTIL X CONVERGES TO TWO 
DECIMAL PLACES 
160 IF (ABS(DX/X) .LE..085) GO TO 188 
FF = PT(1) 
DF = FF 
DO 178 I=2,N 
FF = FF*X + PT(I) 
DF = DF*X + FF 
178 CONTINUE 


FF = FF*X + PT(NN) 
DX = FF/DF 
X = K - DX 
GO TO 168 
188 BND = X 


COMPUTE THE DERIVATIVE AS THE INTIAL K POLYNOMIAL 
AND DO 5 STEPS WITH NO SHIFT 
NM1 = N- 1 
DO 19@ I=2,N 
K(I) = FLOAT (NN-I) *P(1I) /FLOAT(N) 
198 CONTINUE 


K(1) = P(1) 
AA = P(NN) 
BB = P(N) 


ZEROK = K(N).EQ.9.D@ 
DO 230 JJ=1,5 
CC = K(N) 
IF (ZEROK) GO TO 2186 
USE SCALED FORM OF RECURRENCE IF VALUE OF K AT 9 IS 
NONZERO 
T = -AA/CC 
DO 288 I=1,NM1 
J = NN - I 
K(J) = T*K(J-1) + P(Jd) 
2068 CONTINUE 
K(1l) = P(1) 
ZEROK = DABS(K(N)).LE.DABS(BB) *ETA*16@. 
GO TO 230 
USE UNSCALED FORM OF RECURRENCE 
218 DO 228 I=1,NM1 
J = NN - I 
K(J) = K(J-1) 
226 CONTINUE 
K(1) = 6.D8 
ZEROK = K(N).EQ.9.D@ 
230 CONTINUE 
SAVE K FOR RESTARTS WITH NEW SHIFTS 
DO 248 I=1,N 
TEMP(I) = K(TI) 
248 CONTINUE 
LOOP TO SELECT THE QUADRATIC CORRESPONDING TO EACH 
NEW SHIFT 
DO 28@ CNT=1,29 
QUADRATIC CORRESPONDS TO A DOUBLE SHIFT TO A 
NON-REAL POINT AND ITS COMPLEX CONJUGATE. THE POINT 
HAS MODULUS BND AND AMPLITUDE ROTATED BY 94 DEGREES 
FROM THE PREVIOUS SHIFT 
XXX = COSR*XX -— SINR*YY 


YY = SINR*XX + COSR*YY 
XX = XXX 

SR = BND*XX 

SI = BND*YY 

U = -2.6D8@*SR 

V = BND 


SECOND STAGE CALCULATION, FIXED QUADRATIC 

CALL FXSHFR(2@*CNT, NZ) 

IF (NZ.EQ.6) GO TO 268 
THE SECOND STAGE JUMPS DIRECTLY TO ONE OF THE THIRD 
STAGE ITERATIONS AND RETURNS HERE IF SUCCESSFUL. 
DEFLATE THE POLYNOMIAL, STORE THE ZERO OR ZEROS AND 
RETURN TO THE MAIN ALGORITHM. 

J = DEGREE - N +1 

ZEROR(J) = SZR 

ZEROI(J) = S21 

NN = NN - NZ 

N= NN - 1] 

DO 258 I=1,NN 

P(I) = QP(T) 

258 CONTINUE 

IF (NZ.EQ.1) GO TO 40 


ZEROR(J+1) = LZR 
ZEROI(J+1) = LZI 
GO TO 48 


IF THE ITERATION IS UNSUCCESSFUL ANOTHER QUADRATIC 
IS CHOSEN AFTER RESTORING K 
268 DO 276 I=1,N 
K(I) = TEMP(T) 
270 CONTINUE 
288 CONTINUE 
RETURN WITH FAILURE IF NO CONVERGENCE WITH 28 
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SHIFTS 
FAIL = .TRUE. 
DEGREE = DEGREE - N 
RETURN 
END 


SUBROUTINE FXSHFR(L2, NZ) 
COMPUTES UP TO L2 FIXED SHIFT K-POLYNOMIALS, 
TESTING FOR CONVERGENCE IN THE LINEAR OR QUADRATIC 
CASE. INITIATES ONE OF THE VARIABLE SHIFT 
ITERATIONS AND RETURNS WITH THE NUMBER OF ZEROS 
FOUND. 
L2 - LIMIT OF FIXED SHIFT STEPS 
NZ - NUMBER OF ZEROS FOUND 

COMMON /GLOBAL/ P, QP, K, QK, SVK, SR, SI, U, 

* v, A, B, C, D, Al, A2, A3, A6, A7, E, F, G, 

* H, SZ2R, SZI, LZR, L2I, ETA, ARE, MRE, N, NN 

DOUBLE PRECISION P(101), QP(1@1), K(1@1), 

* QK(101), SVK(101), SR, SI, U, V, A, B, C, D, 

* Al, A2, A3, A6, A7, E, F, G, H, SZR, S2I, 

* LZR, L2t 

REAL ETA, ARE, MRE 

INTEGER N, NN 

DOUBLE PRECISION SVU, SVV, UI, VI, S 

REAL BETAS, BETAV, OSS, OVV, SS, VV, TS, TV, 

* OTS. OTV, TVV, TSS 

INTEGER L2, NZ, TYPE, IL, J, IFLAG 

LOGICAL VPASS, SPASS, VTRY, STRY 


NZ = 8 
BETAV = .25 
BETAS = .25 
OSS = SR 
OVV = V 


EVALUATE POLYNOMIAL BY SYNTHETIC DIVISION 
CALL QUADSD(NN, U, V, P, QP, A, B) 
CALL CALCSC (TYPE) 

DO 88 J=1,L2 
CALCULATE NEXT K POLYNOMIAL AND ESTIMATE V 
CALL NEXTK (TYPE) 
CALL CALCSC (TYPE) 
CALL NEWEST(TYPE, UI, VI) 


vw = VI 
ESTIMATE S 
SS = @. 
IF (K(N).NE.@.D@) SS = -P(NN)/K(N) 
Tv = 1. 
tT = 1 


IF (J.EQ.1 .OR. TYPE.EQ.3) GO TO 78 
COMPUTE RELATIVE MEASURES OF CONVERGENCE OF S AND V 
SEQUENCES 
IF (VV.NE.@.) TV = ABS((VV-OVV)/VV) 
IF (SS.NE.@.) TS = ABS((SS-OSS)/SS) 
IF DECREASING, MULTIPLY TWO MOST RECENT 
CONVERGENCE MEASURES 


Tvv = 1. 
IF (TV.LT.OTV) TVV = TV*OTV 
TSS = 1. 


IF (TS.LT.OTS) TSS = TS*OTS 
COMPARE WITH CONVERGENCE CRITERIA 
VPASS = TVV.LT.BETAV 
SPASS = TSS.LT.BETAS 
IF (.NOT.(SPASS .OR. VPASS)) GO TO 78 
AT LEAST ONE SEQUENCE HAS PASSED THE CONVERGENCE 
TEST. STORE VARIABLES BEFORE ITERATING 
svU = U 
SVV = V 
DO 18 I=1,N 
SVK(I) = K(I) 
18 CONTINUE 
S = SS 
CHOOSE ITERATION ACCORDING TO THE FASTEST 
CONVERGING SEQUENCE 
VTRY = .FALSE. 
STRY = .FALSE. 
IF (SPASS .AND. ((.NOT.VPASS) .OR. 
* TSS.LT.TVV)) GO TO 48 
20 CALL QUADIT(UI, VI, NZ) 
IF (NZ.GT.@) RETURN 
QUADRATIC ITERATION HAS FAILED. FLAG THAT IT HAS 
BEEN TRIED AND DECREASE THE CONVERGENCE CRITERION. 
VTRY = .TRUE. 
BETAV = BETAV*.25 
TRY LINEAR ITERATION IF IT HAS NOT BEEN TRIED AND 
THE S SEQUENCE IS CONVERGING 
IF (STRY .OR. (.NOT.SPASS)) GO TO 5@ 
DO 38 I=1,N 
K(I) = SVK(TI) 
38 CONTINUE 
46 CALL REALIT(S, NZ, IFLAG) 
IF (NZ.GT.@) RETURN 


RPO 
RPO 
RPO 
RPO 
RPO 


FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
PXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 
FXS 


493-P 5- 


0 


COLLECTED ALGORITHMS (cont.) 


C LINEAR ITERATION HAS FAILED. FLAG THAT IT HAS BEEN 
C TRIED AND DECREASE THE CONVERGENCE CRITERION 


aa aa 


QaNAANAN 


aaa Qa 


STRY = .TRUE. 

BETAS = BETAS*.25 

IF (IFLAG.EQ.@) GO TO 5¢ 
IF LINEAR ITERATION SIGNALS AN ALMOST DOUBLE REAL 
ZERO ATTEMPT QUADRATIC INTERATION 


UI = -(S+S) 
VI = S*S 
GO TO 20 


RESTORE VARIABLES 
56 U = SVU 
V = SVV 
DO 68 I=1,N 
K(I) = SVK(I) 
68 CONTINUE 
TRY QUADRATIC ITERATION IF IT HAS NOT BEEN TRIED 
AND THE V SEQUENCE IS CONVERGING 
IF (VPASS .AND. (.NOT.VTRY)) GO TO 28 
RECOMPUTE QP AND SCALAR VALUES TO CONTINUE THE 
SECOND STAGE 
CALL QUADSD(NN, U, V, P, QP, A, B) 
CALL CALCSC (TYPE) 


70 OVV = VV 
OSS = SS 
OTV = TV 
OTS = TS 
8@ CONTINUE 
RETURN 
END 


SUBROUTINE QUADIT(UU, VV, NZ) 
VARIABLE-SHIFT K-POLYNOMIAL ITERATION FOR A 
QUADRATIC FACTOR CONVERGES ONLY IF THE ZEROS ARE 
EQUIMODULAR OR NEARLY SO. 
UU,VV - COEFFICIENTS OF STARTING QUADRATIC 
NZ - NUMBER OF ZERO FOUND 
COMMON /GLOBAL/ P, QP, K, QK, SVK, SR, SI, U, 
aM hy Be Ce Dg Bip: Ad, As Roy Aly Ee Pe. Gy 
* H, SZR, SZI, LZR, LZI, ETA, ARE, MRE, N, NN 
DOUBLE PRECISION P(1@1), QP(1@1), K(1@1), 
* QK(101), SVK(1@1), SR, SI, U, V, A, B, C, D, 
* AL, -A2, A3p AG, AT, Ep Be Gy Bj SZRe-S2i- 
* LZR, LZ 
REAL ETA, ARE, MRE 
INTEGER N, NN 
DOUBLE PRECISION UI, VI, UU, VV, DABS 
REAL MS, MP, OMP, EE, RELSTP, T, ZM 
INTEGER NZ, TYPE, I, J 
LOGICAL TRIED 
NZ = 6 
TRIED = .FALSE. 
U = UU 
Vv = vv 
J = 86 
MAIN LOOP 
1@ CALL QUAD(1.D@, U, V, SZR, SZI, LZR, LZI) 
RETURN IF ROOTS OF THE QUADRATIC ARE REAL AND NOT 
CLOSE TO MULTIPLE OR NEARLY EQUAL AND OF OPPOSITE 
SIGN 
IF (DABS (DABS(SZR) -DABS(LZR)) .GT..@1D8* 
* DABS(LZR)) RETURN 
EVALUATE POLYNOMIAL BY QUADRATIC SYNTHETIC DIVISION 
CALL QUADSD(NN, U, V, P, QP, A, B) 
MP = DABS(A-SZR*B) + DABS(SZI*B) 
COMPUTE A RIGOROUS BOUND ON THE ROUNDING ERROR IN 
EVALUTING P 
ZM = SQRT(ABS(SNGL(V) ) 
EE = 2.*ABS(SNGL(QP(1) 
T = -SZR*B 
DO 2@ I=2,N 
EE = EE*ZM + ABS(SNGL(QP(I))) 
20 CONTINUE 
EE = EE*ZM + ABS(SNGL(A) +T) 
EE = (5.*MRE+4.*ARE)*EE - (5.*MRE+2.*ARE) * 
* (ABS (SNGL(A)+T)+ABS(SNGL(B))*ZM) + 
* 2.*ARE*ABS (T) 
ITERATION HAS CONVERGED SUFFICIENTLY IF THE 
POLYNOMIAL VALUE IS LESS THAN 2@ TIMES THIS BOUND 
IF (MP.GT.2@.*EE) GO TO 30 
NZ = 2 
RETURN 
38 J=J +1 
STOP ITERATION AFTER 20 STEPS 
IF (J.GT.2@) RETURN 
IF (J.LT.2) GO TO 58 
IF (RELSTP.GT..@1 .OR. MP.LT.OMP .OR. TRIED) 
* GO TO 58 
A CLUSTER APPEARS TO BE STALLING THE CONVERGENCE. 


) 
)) 
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Cc 
Cc 


Cc 


Cc 


ANAAANAAN 


AA 


FIVE FIXED SHIFT STEPS ARE TAKEN WITH A U,V CLOSE 
TO THE CLUSTER 
IF (RELSTP.LT.ETA) RELSTP = ETA 
RELSTP = SORT(RELSTP) 
U = U - U*RELSTP 
V = V + V*RELSTP 
CALL QUADSD(NN, U, V, P, QP, A, B) 
DO 40 T=1,5 
CALL CALCSC (TYPE) 
CALL NEXTK (TYPE) 
48 CONTINUE 
TRIED = .TRUE. 
J = 6 
5@ OMP = MP 
CALCULATE NEXT K POLYNOMIAL AND NEW U AND V 
CALL CALCSC (TYPE) 
CALL NEXTK (TYPE) 
CALL CALCSC (TYPE) 
CALL NEWEST(TYPE, UI, VI) 
IF VI IS ZERO THE ITERATION IS NOT CONVERGING 
IF (VI.EQ.@.D@) RETURN 
RELSTP = DABS((VI-V)/VI) 


U = UI 

Vv = VI 
GO TO 18 
END 


SUBROUTINE REALIT(SSS, NZ, IFLAG) 


VARIABLE-SHIFT H POLYNOMIAL ITERATION FOR A REAL 
ZERO. 
SSS - STARTING ITERATE 
NZ - NUMBER OF ZERO FOUND 
IFLAG - FLAG TO INDICATE A PAIR OF ZEROS NEAR REAL 
AXIS. 
COMMON /GLOBAL/ P, QP, K, QK, SVK, SR, SI, U, 
* v, A, B, C, D, Al, A2, A3, A6, A7, E, F, G, 
* H, SZR, SZI, LZR, LZI, ETA, ARE, MRE, N, NN 
DOUBLE PRECISION P(1@1), QP(161), K(1@1), 
* QK(181), SVK(181), SR, SI, U, V, A, B, C, D, 
* Al, A2, A3, AG, A7, E, F, G, H, S2R, SZI, 
* LZR, LZI 
REAL ETA, ARE, MRE 
INTEGER N, NN 
DOUBLE PRECISION PV, KV, T, S, SSS, DABS 
REAL MS, MP, OMP, EE 
INTEGER NZ, IFLAG, I, J, NM1 
NM1 = N- 1 
NZ = 6 
S = SSS 
IFLAG = @ 
J = 6 
MAIN LOOP 
16 PV = P(1) 
EVALUATE P AT S 
QP(1) = PV 


DO 2@ I=2,NN 
PV = Pv*S + P(I) 
QP(I) = PV 
20 CONTINUE 
MP = DABS(PV) 
COMPUTE A RIGOROUS BOUND ON THE ERROR IN EVALUATING 
P 
MS = DABS(S) 
EE = (MRE/(ARE+MRE) ) *ABS(SNGL(QP(1))) 
DO 3@ I=2,NN 
EE = EE*MS + ABS(SNGL(QP(I))) 
30 CONTINUE 
ITERATION HAS CONVERGED SUFFICIENTLY IF THE 
POLYNOMIAL VALUE IS LESS THAN 2@ TIMES THIS BOUND 
IF (MP.GT.2@.*((ARE+MRE) *EE-MRE*MP)) GO TO 4@ 


NZ = 1 
SZR =S8S 
SZI = @.D@ 
RETURN 


49 J=J39+1 
STOP ITERATION AFTER 19 STEPS 
IF (J.GT.18) RETURN 
IF (J.LT.2) GO TO 58 
IF (DABS(T).GT..@@1*DABS(S-T) .OR. MP.LE.OMP) 
* GO TO 586 
A CLUSTER OF ZEROS NEAR THE REAL AXIS HAS BEEN 
ENCOUNTERED RETURN WITH IFLAG SET TO INITIATE A 
QUADRATIC ITERATION 
IFLAG = 1 
sss = S& 
RETURN 
RETURN IF THE POLYNOMIAL VALUE HAS INCREASED 
SIGNIFICANTLY 
5@ OMP = MP 
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C COMPUTE T, THE NEXT POLYNOMIAL, AND THE NEW ITERATE 


aa 


ANAADRA 


KV = K(1) 
QK(1) = KV 
DO 6@ I1=2,N 
KV = KV*S + K(TI) 
QK({I) = KV 
66 CONTINUE 
IF (DABS(KV) .LE.DABS(K(N))*10.*ETA) GO TO 8@ 
USE THE SCALED FORM OF THE RECURRENCE IF THE VALUE 
OF K AT § IS NONZERO 
T = -~PV/KV 
K(1) = QP(1) 
DO 79 I=2,N 
K(I) = T*QK(I-1) + QP(I) 
76 CONTINUE 
GO TO 188 
USE UNSCALED FORM 
88 K(1) = @.0D@ 
DO 99 I=2,N 
K(I) = QK(I-1) 
9@ CONTINUE 
198 KV = K(1) 
DO 11@ I=2,N 
KV = KV*S + K(I) 
11@ CONTINUE 


T = @.D9@ 

IF (DABS(KV).GT.DABS(K(N))*1@.*ETA) T = -PV/KV 
s=s +fT 

GO TO 18 

END 


SUBROUTINE CALCSC (TYPE) 
THIS ROUTINE CALCULATES SCALAR QUANTITIES USED TO 
COMPUTE THE NEXT K POLYNOMIAL AND NEW ESTIMATES OF 
THE QUADRATIC COEFFICIENTS. 
TYPE - INTEGER VARIABLE SET HERE INDICATING HOW THE 
CALCULATIONS ARE NORMALIZED TO AVOID OVERFLOW 

COMMON /GLOBAL/ P, QP, K, QK, SVK, SR, SI, U, 

* v, A, B, C, D, Al, A2, A3, A6, AT, E, F, G, 

* H, SZR, SZI, LZR, LZI, ETA, ARE, MRE, N, NN 

DOUBLE PRECISION P(181), QP(181), K(1@1), 

* QK(161), SVK(18@1), SR, SI, U, V, A, B, C, D, 

* Al, A2, A3, A6, A7, E, F, G, H, SZR, SZI, 

* LZR, L2I 

REAL ETA, ARE, MRE 

INTEGER N, NN 

DOUBLE PRECISION DABS 

INTEGER TYPE 
SYNTHETIC DIVISION OF K BY THE QUADRATIC 1,U,V 

CALL QUADSD(N, U, V, K, QK, C, D) 

IF (DABS(C).GT.DABS(K(N))*10@.*ETA) GO TO 18 

IF (DABS(D).GT.DABS(K(N-1))*10@.*ETA) GO TO 18 

TYPE = 3 
TYPE=3 INDICATES THE QUADRATIC IS ALMOST A FACTOR 
OF K 


RETURN 
19 IF (DABS(D).LT.DABS(C)) GO TO 20 

TYPE = 2 

TYPE=2 INDICATES THAT ALL FORMULAS ARE DIVIDED BY D 
E = A/D 
F = C/D 
G = U*B 
H = V*B 
A3 = (A+G)*E + H*(B/D) 
Al = BYF -A 
A7 = (F+U)*A + H 
RETURN 

26 TYPE = 1 

TYPE=1 INDICATES THAT ALL FORMULAS ARE DIVIDED BY C 
E = A/C 
F = D/C 
G = U*E 
H = V*B 
A3 = A*E + (H/C+G)*B 
Al = B - A*(D/C) 
A7 = A + G*D + H*F 
RETURN 
END 


SUBROUTINE NEXTK (TYPE) 


C COMPUTES THE NEXT K POLYNOMIALS USING SCALARS 
C COMPUTED IN CALCSC 


COMMON /GLOBAL/ P, QP, K, QK, SVK, SR, SI, U, 
* Vv, A, B, C, D, Al, A2, A3, A6, AT, E, F, G, 
* H, SZR, SZI, LZR, LZI, ETA, ARE, MRE, N, NN 

DOUBLE PRECISION P(161), QP(101), K(1@1), 
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* QK(1@1), SVK(101), SR, SI, U, V, A, B, C, D, 
* Al, A2, A3, A6, A7, E, F, G, H, S2R, SZI, 

* LZR, LZI 

REAL ETA, ARE, MRE 

INTEGER N, NN 

DOUBLE PRECISION TEMP, DABS 

INTEGER TYPE 

IF (TYPE.EQ.3) GO TO 46 

TEMP = A 

IF (TYPE.EQ.1) TEMP = B 

IF (DABS(Al) .GT.DABS (TEMP) *ETA*10.) GO TO 22 


C IF Al IS NEARLY ZERO THEN USE A SPECIAL FORM OF THE 
C RECURRENCE 


36 


C USE 
4D 


58 


K(1) = 0.D@ 
K(2) = -A7*QP(1) 
DO 1@ I=3,N 
-K(I) = A3*QK(I-2) - A7*QP(I-1) 
CONTINUE 
RETURN 
SCALED FORM OF THE RECURRENCE 
A7 = A7/Al 
A3 = A3/Al 
K(1) = QP(1) 
K(2) = QP(2) - A7*QP(1) 
DO 39 I=3,N 
K(I) = A3*QK(I-2) - A7*QP(I-1) + QP(1) 
CONTINUE 
RETURN 
UNSCALED FORM OF THE RECURRENCE IF TYPE IS 3 
K(1) = 8.D0 
K(2) = @.D@ 
DO 5@ I=3,N 
K(I) = QK(I-2) 
CONTINUE 
RETURN 
END 


SUBROUTINE NEWEST(TYPE, UU, VV) 


C COMPUTE NEW ESTIMATES OF THE QUADRATIC COEFFICIENTS 
C USING THE SCALARS COMPUTED IN CALCSC. 


COMMON /GLOBAL/ P, QP, K, QK, SVK, SR, SI, U, 


* V, A, B, C, D, Al, A2, A3, A6, A7, E, F, G, 
* H, SZR, SZI, LZR, LZI, ETA, ARE, MRE, N, NN 


DOUBLE PRECISION P(101), QP(1@1), K(191), 


* QK(101), SVK(161), SR, SI, U, V, A, B, C, D, 
* Al, A2, A3, A6, A7, E, F, G, H, SZR, S21, 
* LZR, L2i . 


REAL ETA, ARE, MRE 
INTEGER N, NN 
DOUBLE PRECISION A4, A5, Bl, B2, Cl, C2, C3, 


* C4, TEMP, UU, VV 


C USE 


18 


INTEGER TYPE 

FORMULAS APPROPRIATE TO SETTING OF TYPE. 
IF (TYPE.EQ.3) GO TO 30 

IF (TYPE.EQ.2) GO TO 18 

A4 = A + U*B + H*F 

A5 = C + (U+V*F)*D 

GO TO 29 

A4 = (A+G)*F + H 

(F+U)*C + V*D 


C EVALUATE NEW QUADRATIC COEFFICIENTS. 


20 


Bl = -K(N)/P (NN) 

B2 = -(K(N-1)+B1*P(N))/P(NN) 
Cl = V*B2*Al 

C2 = B1*A7 

C3 = B1*B1*A3 

C4 = Cl - C2 - C3 


TEMP = A5 + B1*A4 - C4 
IF (TEMP.EQ.8.D#) GO TO 38 
UU = U - (U*(C3+C2) +V* (B1*A1+B2*A7) ) /TEMP 


VV = V*(1.4+C4/TEMP) 
RETURN 
C IF TYPE=3 THE QUADRATIC IS ZEROED 
36 UU = O.DB 
VV = @.D@ 
RETURN 
END 


SUBROUTINE QUADSD(NN, U, V, P, Q, A, B) 


C DIVIDES P BY THE QUADRATIC 1,U,V PLACING THE 
C QUOTIENT IN Q AND THE REMAINDER IN A,B 


DOUBLE PRECISION P(NN), Q(NN), U, V, A, B, C 
INTEGER I 
B = P(1) 
Q(1) = 8B 
A = P(2) - U*B 
Q(2) =A 
DO 18 I=3,NN 
C = P(I) - U*A - V*B 
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Q(I) = Cc 
B=A 
A=C 
1@ CONTINUE 
RETURN 
END 
SUBROUTINE QUAD(A, Bl, C, SR, SI, LR, LI) 


THE QUADRATIC FORMULA, MODIFIED TO AVOID 
OVERFLOW, IS USED TO FIND THE LARGER ZERO IF THE 
ZEROS ARE REAL AND BOTH ZEROS ARE COMPLEX. 
THE SMALLER REAL ZERO IS FOUND DIRECTLY FROM THE 
PRODUCT OF THE ZEROS C/A. 

DOUBLE PRECISION A, Bl, C, SR, SI, LR, LI, B, 

* D, E, DABS, DSQRT 

IF (A.NE.@.D@) GO TO 28 


AaAAAAN 


SR = 6.DO 
IF (B1.NE.@.D®) SR = -C/Bl 
LR = 6.D® 
16 SI = 0.D@ 
LI = @.D® 
RETURN 
20 IF (C.NE.@.D0) GO TO 38 
SR = 9.D@ 
LR = -B1/A 
GO TO 10 


C COMPUTE DISCRIMINANT AVOIDING OVERFLOW 
38 B = B1/2.D6 
IF (DABS(B) .LT.DABS(C)) GO TO 40 


E = 1.D@ - (A/B)*(C/B) 
D = DSQRT (DABS (E) ) *DABS (B) 
GO TO 58 
40 E=A 
IF (C.LT.8.D@) E = -A 
E = B*(B/DABS(C)) - E 
D = DSQRT (DABS (E) ) *DSQRT (DABS (C) ) 


5@ IF (E.LT.@.D8#) GO TO 69 
C REAL ZEROS 
IF (B.GE.@.D8@) D = =D 


LR = (-BtD)/A 
SR = 8.D@ 
IF (LR.NE.®@.D@) SR = (C/LR)/A 
GO TO 18 
C COMPLEX CONJUGATE ZEROS 
68 SR = -B/A 
LR = SR 
SI = DABS (D/A) 
LI = -SI 
RETURN 
END 


CALCULATE THE ZEROS OF THE QUADRATIC A*Z**2+B1*Z+C. 
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ALGORITHM 494 


PDEONE, Solutions of Systems of Partial 
Differential Equations [D3 | 


RICHARD F. SINCOVEC 
Kansas State University 
and 

NIEL K. MADSEN 


Lawrence Livermore Laboratory 


Key Words and Phrases: partial differential equations, method of lines, ordinary 
differential equations 

CR Categories: 5.17 

Language: Fortran 


DESCRIPTION 


The description of this algorithm, test results, and references are contained in the 
authors’ paper, “Software for Nonlinear Partial Differential Equations,’’ ACM 
Trans. Math. Software 1, 3 (Sept. 1975) , 232-260. 


ALGORITHM 

SUBROUTINE PDEGNE(T, U, UDOT, NPDE, NPTS) PDE 106 

DIMENSION U(NPDE,NPTS), UDOT(NPDE,NPTS) PDE 28 
C PDEONE IS AN INTERFACE SUBROUTINE WHICH USES CENTERED DIF- PDE 32 
C FERENCE APPROXIMATIONS TO CONVERT ONE-DIMENSIONAL SYSTEMS PDE 4@ 
C OF PARTIAL DIFFERENTIAL EQUATIONS INTO A SYSTEM OF ORDINARY PDE 58 
C DIFFERENTIAL EQUATIONS, UDOT = F(T,X,U). THIS ROUTINE IS PDE 68 
C INVENDED TO BE USED WITH A ROBUST ODE INTEGRATOR. PDE 70 
C INPUT... PDE 80 
C NPDE = NUMBER OF PARTIAL DIFFERENTIAL EQUATIONS. PDE 90 
C NPTS = NUMBER OF SPATIAL GRID POINTS. PDE 160 
c {T = CURRENT VALUE OF TIME. PDE 116 
Cc U = AN NPDE BY NPTS ARRAY CONTAINING THE COMPUTED PDE 120 
fe SOLUTION AT TIME T. PDE 13@ 
C OUTPUT... PDE 149 
C UDOT = AN NPDE BY NPTS ARRAY CONTAINING THE RIGHT HAND PDE 156 
c SIDE OF THE RESULTING SYSTEM OF ODE*S, F(T,X,U), PDE 166 
Cc OBTAINED BY DISCKETIZING THE GIVEN PDE*S. PDE 170 
C THE USER MUST INSERT A DIMENSION STATEMENT OF THE FOLLOW- PDE 180 
C ING FORM.. PDE 198 
Cc DIMENSIGN DVAL(**,**,2) ,UX(**) ,UAVG(**) ,ALPHA(**) , PDE 260 
C * BETA (**) ,GAMMA (**) PDE 210 
C THE SYMBOLS ** DENOTE THE ACTUAL NUMERICAL VALUE OF NPDE PDE 220 
C FOR THE PROBLEM BEING SOLVED. PDE 230 
C COMMON BLOCK MESh CONTAINS THE USER SPECIFIED SPATIAL PDE 240 
C GRID POINTS. PDE 250 
C COMMON BLOCK COORD CONTAINS 0,1, OR 2 DEPENDING ON WHETHER PDE 260 
C THE PROBLEM IS IN CARTESIAN, CYLINDRICAL, OR SPHERICAL PDE 270 
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C COORDINATES, RESPECTIVELY. 


COMMON /MESH/ X(1) 
COMMON /COORD/ ICORD 
ICORD1 = ICORD + 1 


C UPDATE THE LEFT BOUNDARY VALUES 


a 


Cc 
Cc 


aa 


CALL BNDRY(T, X(1), U, ALPHA, BETA, GAMMA, NPDE) 
ITEST = @ 
DXI = 1./(&(2)-x(1)) 
DO 19 K=1,NPDE 
IF (BETA(K).NE.®.@) GO TO 18 
U(K,1) = GAMMA(K) /ALPHA(K) 
ITEST = ITEST + 1 
10 CONTINUE 
IF (ITEST.EQ.NPDE) GO TO 5@ 
IF (ITEST.EQ.@) GO TO 20 
CALL BNDRY(T, X(1), U, ALPHA, BETA, GAMMA, NPDB) 
EVALUATE D COEFFICIENTS AT THE LEFT BOUNDARY 
2@ CALL D(T, X(1), U, DVAL, NPDE) 
FORM APPROXIMATIONS TO DU/DX AT THE LEFT BOUNDARY 
DO 40 K=1,NPDE 
IF (BETA(K).NE.@.@) GO TO 30 


UX(K) = DXI*(U(K,2)-U(K,1)) 
GO TO 40 
30 UX(K) = (GAMMA(K)-ALPHA(K) *U(K,1))/BETA(K) 


40 CONTINUE 
EVALUATE U~AVERAGE IN THE FIRST INTERVAL 
5@ DO 6@ K=1,NPDE 
UVAVG(K) = .5*(U(K,2)+U(K,1)) 
6@ CONTINUE 
EVALUATE D COEFFICIENTS IN THE FIRST INTERVAL 


XAVGR = .5*(X(2)+X(1)) 

CALL D(T, XAVGR, UAVG, DVAL(1,1,2), NPDE) 
DXIL = 1. 

DXIR = DXI 


IF (ICORD.EQ.8) GO TO 78 
DXIL = X(1)**ICORD 
DXIR = DXIR*XAVGR**ICORD 
EVALUATE DUXX AT THE LEFT BOUNDARY 
70 IF (ITEST.EO.NPDE) GO TO 100 
DXIC = FLOAT (ICOKD1) / (XAVGR** ICORD1-X (1) ** ICORD1) 
DO 9@ L=1,NPDE 
DO 80 K=1,NPDE 
DVAL(K,L,1) = DXIC* (DVAL(K,L,2)*(U(L,2)-U(L,1))* 
7 DXIR-DVAL(K,L,1) *UX(L) *DXIL) 
89 CONTINUE 
96 CONTINUE 
EVALUATE RIGHTHAND SIDE OF PDE*S AT THE LEFT BOUNDARY 
CALL F(T, X(1), U, UX, DVAL, UDOT, NPDE) 
SET UDOT = @ FOR KNOWN LEFT BOUNDARY VALUES 
10@ DO 110 K=1,NPDE 
If (BETA(K).EQ.@.8) UDOT(K,1) = 9.9 
114 CONTINUE 
UPDATE THE RIGHT BOUNDARY VALUES 


CALL BNDRY(T, X(NPTS), U(1,NPTS), ALPHA, BETA, GAMMA, NPDE) 


ITEST = Q 
DO 12@ K=1,NPDE 
IF (BETA(K).NE.@.@) GO TO 120 
U(K,NPTS) = GAMMA(K) /ALPHA(K) 
ITEST = ITEST + 1 
126 CONTINUE 


IBCK = 1 
IFWD = 2 
ILIM = NPTS - 1 


MAIN LOOP TO FORM ORDINARY DIFFERENTIAL EQUATIONS AT THE 
GRID POINTS 
DO 160 1=2,ILIM 


K = IBCK 

IBCK = IFwD 

IFwD = K 

XAVGL = XAVGR 

XAVGR = .5*(X(I+1)+X(I)) 
DXI = 1./(X(1I+1)-X(I-1)) 


DXIL = DXIR 
DXIR = 1./(X(I+1)-X(I)) 
IF (ICORCD.NE.@) DXIR = DXIR*XAVGR**ICORD 
DXIC = FLOAT (ICORD1) / (KAVGR** ICORD1-—XAVGL** ICORD1) 
EVALUATE DU/DX AND U-AVERAGE AT THE I-TH GRID POINT AND 
INTERVAL RESPECTIVELY 
DO 130 K=1,NPDE 
UX(K) = DXI* (U(K,I+1)-U(K,I-1)) 
UAVG(K) = .5*(U(K,I+1)+U(K,1)) 
130 CONTINUE 
EVALUATE DO COLFFICIENTS IN THE I-TH INTERVAL 
CALL D(T, XAVGR, UAVG, DVAL(1,1,IFWD), NPDE) 
EVALUATE DUXX AT THE I-TH GRID POINT 
DO 150 L=1,NPDE 
bO 14@ K=1,NPDE 


DVAL(K,L,IBCK) = (DVAL(K,L,IFWD) * (U(L,I+1)-U(L,I))* 
* DXIR-DVAL(K,L,IBCK) *(U(L,1)-U(L,I-1) ) *DXIL) *DXIC 
1460 CONTINUE 


158 CONTINUE 
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C EVALUATE KIGHTHAND SIDE OF PDE*S AT THE I-TH GRID POINT PDE 1196 
CALL F(T, X(I), U(1,1I), UX, DVAL(1,1,IBCK), UDOT(1,1), NPDE) PDE 1206 

168 CONTINUE PDE 1219 

C FINISH UPDATING THE RIGHT BOUNDARY IF NECESSARY PDE 1226 
IF (ITEST.EQ.NPDE) GO TO 220 PDE 1236 

IF (ITEST.EQ.8) GO TO 170 PDE 1246 

CALL BNDRY(T, X(NPTS), U(1,NPTS), ALPHA, BETA, GAMMA, NPDE) PDE 1258 

C EVALUATE D COEFFICIENTS AT THE RIGHT BOUNDARY PDE 1269 
17@ CALL D(T, X(NPTS), U(1,NPIS), DVAL(1,1,IBCK), NPDE) PDE 1276 

C FORM APPROXIMATIONS TO DU/DX AT THE RIGHT BOUNDARY PDE 1288 
DXI = 1./(X(NPTS) -X(ILIM) ) PDE 1290 

DO 19% K=1,NPDE PDE 1306 

IF (BETA(K).NE.@.@) GO TO 180 PDE 1319 

UX(K) = DXI*(U(K,NPTS)-U(K,ILIM) ) PDE 1326 

GO 10 190 PDE 1338 

180 UX(K) = (GAMMA (K)-ALPHA(K) *U(K,NPTS) ) /BETA (Kk) PDE 1340 
19@ CONTINUE PDE 1358 
DXIL = DXIK PDE 1368 

DXIR = l. PDE 1376 

IF (ICORD.NE.@) DXIR = X(NPTS) **ICORD PDE 1388 

DXIC = FLOAT (ICORD1)/(X(NPTS) **ICORD1-XAVGR** ICORD1) PDE 1398 

C EVALUATE DUXX AT THE RIGHT BOUNDARY PDE 1400 
DO 216 L=1,NPDE PDE 1416 

DO 200 K=1,NPDE PDE 1426 
DVAL(K,L,IBCK) = DXIC* (DVAL(K,L,IBCK) *UX(L) *DXIR-DVAL(K,L, PDE 1438 

* IFWD) * (U(L,NPTS) -U(L,ILIM) ) *DXIL) PDE 1446 

200 CONTINUE PDE 1456 
218 CONTINUE PDE 1460 

C EVALUATE RIGHTHAND SIDE OF PDE*S AT THE RIGHT BOUNDARY PDE 1476 
CALL F(T, X(NPTS), U(1,NPTS), UX, DVAL(1,1,IBCK), PDE 1480 

* UDOT(1,NPTS), NPDE) PDE 1498 

C SET UDOT = @ FOR KNOWN RIGHT BOUNDARY VALUES PDE 1560 
220 DC 23@ K=1,NPDE PDE 1518 
If (BETA(K).EQ.0.9) UDOT(K,NPTS) = 0.6 PDE 1529 

23@ CONTINUE PDE 1536 
RETURN PDE 1548 


END PDE 1558 
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ALGORITHM 495 


Solution of an Overdetermined System of Linear 
Equations in the Chebyshev Norm [F4| 


1. BARRODALE 

University of Victoria, Canada 
and 

C. PHILLIPS 


University of Liverpool, England 


Key Words and Phrases: Chebyshev solution, overdetermined system, linear program- 
ming, simplex method 

CR Categories: 3.15 

Language: Fortran 


DESCRIPTION 


The algorithm calculates a Chebyshev (or /,,) solution to an m X n overdetermined 
system of linear equations Ax = 0, i.e. given equations 

Dd a,32; = bi, a=1,2,...,m,m2n, 

j=l 
the subroutine determines a vector «* = [m*, a*,..., 2¢n*]' which minimizes the 
maximum absolute value of the residuals 


bs — >> i,j Vj (1) 


j=l 


e(x) = || 6 — Ax||,. = max 

1S ism 

The algorithm can be used to solve the linear Chebyshev data fitting problem. 

Suppose that data consisting of m points (z;, y;) are to be approximated by a 

linear approximating function a1¢1(z) + aed2(z) + +++ + andn(z) in the Chebyshev 

norm. This is equivalent to finding a Chebyshev solution to the system of linear 
equations 


1 

S a a 

2 05 (21) 0; = Yi, a7=1,2,...,m. 
jel 


If the y; values contain only small inherent errors, a Chebyshev approximation 
may be preferred to a least-squares or least-first-power approximation. 
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The algorithm is a modification of the simplex method of linear programming 
applied to the dual formulation of the Chebyshev problem. It does not require that 
the m X n matrix of coefficients A = {a;,;} satisfy the Haar condition, nor does it 
require that it be of full rank. Computational experience with this and other 
algorithms indicates that it is efficient in both time and storage requirements. An 
approximate solution is determined during the first & + 1 iterations, where k 
denotes the rank of the matrix A, and in the subsequent iterations this solution is 
refined until either (i) a Chebyshev solution x* is obtained which minimizes ¢(z), 
or (ii) an approximate solution £ is found for which 


(e(#) — e(2*))/e(x*) < RELERR | (2) 


where RELERR is a real variable specified by the user (see below). 

The parameters M and N represent the number of equations and number of 
unknowns, respectively. MDIM and NDIM should be set to at least M + 1 and 
N + 8, respectively. The simplex iterations are carried out in the two-dimensional 
real array A of size (VDIM, MDIM), Initially, the transpose of the matrix A 
must be stored in the first N rows and M columns of -A; this arrangement allows 
the code to correspond closely to the formal description of the algorithm [1]. The 
right-hand-side vector 6 must be stored in the array B. These initial coefficients 
assigned to A and B are subsequently destroyed. TOL is a real variable which 
should be set to a small positive value; e.g. TOL = 10-“ where d represents the 
number of decimal digits of accuracy available. (On an IBM 370 we usually set 
TOL equal to 10-* when using single precision arithmetic and equal to 10-" when 
using double precision arithmetic.) Essentially, the subroutine cannot distinguish 
between zero and any quantity whose magnitude does not exceed TOL. In particular, 
it will not pivot on any number whose magnitude does not exceed TOL. (Con- 
sequently, the subroutine may terminate prematurely if the system of equations is 
poorly scaled.) The parameter RELERR should be set to 0.0 if a Chebyshev 
solution x* is required. If RELERR is set to a positive value, the subroutine deter- 
mines an approximate solution @ satisfying inequality (2); the usual effect of this 
option (say, with RELERR set to 0.1) is a saving in the number of simplex itera- 
tions required. 

On exit, if RELERR was set to 0.0, the array X contains a Chebyshev solution 
x*. However, if the initial value of RELERR was positive, then X contains an 
approximate solution z. The subroutine assigns a new value to RELERR, smaller 
than its initial value, and € satisfies (2) for this new value of RELERR. The rank 
of the m X n matrix A is determined during the first k iterations and assigned to the 
integer RANK. (The rank estimate RANK is dependent upon TOL; decreasing 
the value of TOL may increase the value of RANK.) The residuals 


b — Doansx;, t= 1,2,...,m (3) 
j=l 

are assigned in order to the array B. RESMAX supplies the absolute value of the 
largest residual; this is the minimum value of (1) if RELERR was set to 0.0. If 
RELERR was set to a positive value, then RESMAX gives the value of (1) corre- 
sponding to the approximate solution ¢. (The subroutine, which overwrites the 
original data A and b, supplies the residuals automatically. However, these auto- 
matic residuals may contain few significant figures, especially when RESMAX is 
within one or two orders of magnitude of TOL. Indeed, if RESMAX < TOL the 
automatic residuals may all be set to zero by the subroutine. Jt is therefore often 
advisable to obtain the residuals directly from (3) as an additional calculation.) ITER 
records the number of iterations performed by the simplex method. Finally, OCODE 
is an exit code with the value 1 if a solution is calculated successfully, and 2 if the 
calculations are terminated prematurely. This latter condition occurs only when a 
pivot is encountered whose magnitude does not exceed TOL, and in this event all 
output information pertains to the last completed simplex iteration. Since a 
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Chebyshev solution is not necessarily unique, the subroutine attempts to determine 
if other optimal solutions exist. An exit code of 1 indicates that the solution is 
unique, while an exit code of 0 indicates that the solution is almost certainly not 
unique. (This uncertainty can only be resolved by a close examination of the final 
simplex tableau contained in A, and we do not consider such an examination to be 
warranted in practice). A Chebyshev solution may be nonunique simply because 
the matrix of coefficients A is not of full rank. 

Example. Approximate y(z) = e* by a1 + asz + ase? + auz* in the Chebyshev 
norm on the 51 points defined by z = 0(0.02)1. Equivalently, calculate the 
Chebyshev solution to the system of equations bee zie, = eo, i= 1,2,..., 51, 
where z; = 0.02(¢ — 1). Setting TOL equal to 10-* and setting RELERR to 0.0, 
the subroutine gives the following solution on an IBM 370/145 using single pre- 
cision arithmetic (approximately 7 decimal digits) : x:* = 0.999456, a* = 1.016599, 
x3* = 0.421690, a,* = 0.279989. The number of iterations required is 8, and the 
value of RESMAX is 0.000544. 
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ALGORITHM 

SUBROUTINE CHEB(M, N, MDIM, NDIM, A, B, TOL, RELERR, X, RANK, CHE 10 

* RESMAX, ITER, OCODE) CHE 20 
C THIS SUBROUTINE USES A MODIFICATION OF THE SIMPLEX METHOD CHE 38 
C OF LINEAR PROGRAMMING TO CALCULATE A CHEBYSHEV SOLUTION TO CHE 40 
C AN OVER-DETERMINED SYSTEM OF LINEAR EQUATIONS. CHE 58 
C DESCRIPTION OF PARAMETERS. CHE 60 
CM NUMBER OF EQUATIONS. : CHE 7@ 
CN NUMBER OF UNKNOWNS (N MUST NOT EKCEED M). , CHE 80 
C MDIM THE NUMBER OF COLUMNS OF A, AT LEAST M41. CHE 99 
C NDIM THE NUMBER OF ROWS OF A, AT LEAST Nt3. CHE 188 
CA TWO DIMENSIONAL REAL ARRAY OF SIZE (NDIM,MDIM). CHE 116 
Cc ON ENTRY,THE TRANSPOSE OF THE MATRIX OF CHE 126 
Cc COEFFICIENTS OF THE OVER-DETERKMINED SYSTEM MUST CHE 130 
Cc BE STORED IN THE FIRST M COLUMNS AND N ROWS OF A. CHE 1480 
Cc THESE VALUES ARE DESTROYED BY THE SUBROUTINE. CHE 1586 
Cc B ONE DIMENSIONAL REAL ARRAY OF SIZE MDIM. ON ENTRY, CHE 160 
Cc B MUST CONTAIN THE RIGHT-HAND SIDES OF THE CHE 178 
Cc EQUATIONS IN ITS FIKST M LOCATIONS. ON EXIT, B CHE 1886 
Cc CONTAINS THE RESIDUALS FOR THE EQUATIONS IN ITS CHE 198 
Cc FIRST M LOCATIONS (SEL DESCRIPTION). CHE 2086 
Cc TOL A SMALL POSITIVE TOLERANCE. EMPIRICAL EVIDENCE CHE 216 
Cc SUGGESTS TOL=1** (-D+1) WHERE D REPRESENTS THE CHE 220 
C NUMBER OF DECIMAL DIGITS OF ACCURACY AVAILABLE CHE 230 
Cc (SEE DESCRIPTION). CHE 240 
C RELERR A REAL VARIABLE WHICH ON ENTRY MUST HAVE THE VALUE CHE 256 
€ @.@ IF A CHEBYSHEV SOLUTION IS REQUIRED. IF RELERR CHE 2680 
Cc IS POSITIVE, THE SUBROUTINE CALCULATES AN CHE 270 
Cc APPROXIMATE SOLUTION WITH RELERR AS AN UPPER BOUND CHE 286 
Cc ON THE RELATIVE ERROR OF ITS LARGEST RESIDUAL (SEE CHE 290 
Cc DESCRIPTION-INEQUALITY (2)). ON EXIT, THE VALUE OF CHE 389 
Cc RELERR GIVES A SMALLER UPPER BOUND FOR THIS CHE 310 
Cc RELAVIVE ERROR. CHE . 328 
Cc X ONE DIMENSIONAL REAL ARRAY OF SIZE NDIM. ON EXIT, CHE 338 
Cc THIS ARRAY CONTAINS A SOLUTION TO THE PROBLEM IN CHE 346 
C ITS FIRST N LOCATIONS. ore CHE 358 
C RANK AN INTEGER WHICH GIVES ON EXIT THE RANK OF THE CHE 368 
Cc MATRIX OF COEFFICIENTS. CHE 3786 
C RESMAX THE LAKGEST RESIDUAL IN MAGNITUDE. CHE 3890 
C ITER THE NUMBER OF SIMPLEX ITERATIONS PERFORMED. CHE 398 
C CCODE AN EXIT CODE WITH VALUES... CHE 400 
Cc @ - OPTIMAL SOLUTION WHICH IS PROBABLY CHE 410 
Cc NON-UNIQUE (SEE DESCRIPTION). CHE 4290 
C 1 - UNIQUE OPTIMAL SOLUTION. CHE 4390 
Cc 2 - CALCULATIONS TERMINATED PREMATURELY CHE 4486 
Cc DUE TO ROUNDING ERRORS. CHE 4586 
C IF YOUR FORTRAN COMPILER PERMITS A SINGLE COLUMN OF A TWO CHE 460 
C DIMENSIONAL ARRAY TO BE PASSED TO A ONE DIMENSIONAL ARRAY CHE 4790 
C THROUGH A SUBROUTINE CALL, CONSIDERABLE SAVINGS IN CHE 486 
C EXECUTION TIME MAY BE ACHIEVED THROUGH THE USE OF THE CHE 496 
C FOLLOWING SUBROUTINE WHICH OPERATES ON COLUMN VECTORS. CHE 500 
Cc SUBROUTINE COL (V1,V2,MLT,NOTROW,1I1,NP2) CHE 518 
C THIS SUBROUTINE SUBTRACTS FROM THE VECTOR V1 A MULTIPLE OF CHE 526 
C THE VECTOR V2 STARTING AT THE 11*TH ELEMENT UP TO THE CHE 536 
C NP2*TH ELEMENT, EXCEPT FOR THE NOTROW*TH ELEMENT. CHE 540 
Cc REAL V1(NP2) ,V2(NEF2) ,MLT CHE 556 
Cc DO 1 I=I1,NP2 CHE 560 
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c LF (I.EQ.NOTROW) GO TO 1 CHE 576 
fe V1(I) =V1(1I) -MLT*V2 (I) CHE 586 
C 1 CONTINUE CHE 599 
Cc RETURN CHE 600 
Cc END CHE 610 
C SEE COMMENTS FOLLOWING STATEMENT NUMBEK 346 FOR CHE 620 
C INSTRUCTIONS ON THE IMPLEMENTATION OF THIS MODIFICATION. CHE 630 
DIMENSION A(NDIM,MDIM), B(MDIM), X(NDIM) CHE 640 
INTEGER PROW, PCOL, RANK, RANKP1, OCODE CHE 650 

C BIG MUST BE SET EQUAL TO ANY VERY LARGE REAL CONSTANT. CKE 668 
C ITS VALUE HERE IS APPROPRIATE FOR THE IBM/370/145. CHE 670 
DATA BIG /1.E+75/ CHE 686 

C INITIALIZATION. CHE 690 
MP] = M +1 CHE 700 

NPl = N +1 CHE 710 

NP2 = N + 2 CHE 720 

NP3 = N + 3 CHE 730 

NP1MR = 1 CHE 740 

RANK = N CHE 750 
RELTMP = RELERR CHE 766 
RELERR = @. CHE 770 

DO 19 J=1,M CHE 780 
A(NP1,J).= 1. CHE 796 
A(NP2,J) = -B(J) CHE 806 
A(NP3,J) =N+Jd CHE 816 

10 CONTINUE CHE 820 
A(NP1,MP1) = @. CHE 830 

ITER = @ CHE 840 
OCODE = 1 CHE 850 

DO 2@ I=1,N CHE 860 

X(I) = @. CHE 876 
A(I,MPl) = I CHE 880 

20 CONTINUE CHE 890 

C LEVEL 1. CHE 900 
LEV = 1 CHE 910 

K = 6 CHE 928 

30 K=K#1 CHE 9390 
KPl = K +1 CHE 940 
NPIMK = NPFl - K CHE 959 

MODE = @ CHE 969 

DO 44 J=K,M CHE 976 

B(J) = 1. CHE 980 

49 CONTINUE CHE 999 

C DETERMINE THE VECTOR TO ENTER THE BASIS. CHE 1000 
58 D = -BIG CHE 1610 
DO 68 J=K,M CHE 1028 

IF (B(J).EQ.6.) GO TO 68 CHE 1030 

DD = ABS(A(NP2,J)) CHE 1640 

IF (DD.LE.D) GO TO 60 CHE 1059 

PCOL = J CHE 1060 

D = DD CHE 1070 

66 CONTINUE CHE 1980 
IF (K.GT.1) GO TO 79 CHE 1090 

C TEST FOR ZERO RIGHT-HAND SIDE. CHE 1100 
IF (D.GT.TOL) GO TO 70 CHE 1110 
RESMAX = @. CHE 1120 

MODE = 2 CHE 1138 

GO TO 380 CHE 1140 

C DETERMINE THE VECTOR TO LEAVE THE BASIS. CHE 1150 
70 D = TOL CHE 1160 
DO 8@ I=1,NP1MK CHE 1176 

DD = ABS(A(1,PCOL)) CHE 1180 

IF (DD.LE.D) GO TO 88 CHE 1190 

PROW = I CHE 1200 

D = DD CHE 1210 

88 CONTINUE CHE 1220 

IF (D.GT.TOL) GO TO 330 CHE 1230 

C CHECK FOR LINEAR DEPENDENCE IN LEVEL 1. CHE 1246 
B(PCOL) = @. CHE 1256 

IF (MODE.EQ.1) GO TO 50 CHE 1266 

DO 100 J=K,M CHE 1270 

IF (B(J).EQ.@.) GO TO 100 CHE 1280 

DO 99 I=1,NP1MK CHE 1298 

IF (ABS(A(I,J)).LE.TOL) GG TO 96 CHE 1300 

MODE = 1 CHE 1310 

GO TO 5@ CHE 1326 

99 CONTINUE CHE 1330 
100 CONTINUE CHE 1340 
RANK = K - 1 CHE 1350 
NPIMR = NPl - RANK CHE 1360 
OCODE = ¥g CHE 1370 

GO TO 168 CHE 1380 

110 IF (PCOL.EQ.K) GO TO 136 CHE 1398 
C INTERCHANGE COLUMNS IN LEVEL l. CHE 1408 
DO 128 I=1,NP3 CHE 1410 

Db = A(I,PCOL) CHE 1420 
A(I,PCOL) = A(I,K) CHE 1439 

A(I,K) = D CHE 1449 

120 CONTINUE CHE 1450 
130 IF (PROW.EQ.NPIMK) GU TO 150 CHE 1460 
C INTERCHANGE ROWS IN LEVEL l. CHE 1470 
DO 14@ J=1,MP1 CHE 1486 


D = A(PROW,J) CHE 1499 
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A(PROW,J) = A(NP1MK,J) CHE 15028 
A(NPIMK,J) = D CHE 1518 

148 CONTINUE CHE 15220 
15@ IF (K.LT.N) GO TO 38 CHE 1530 
160 IF (RANK.EQ.M) GO TO 389 CHE 1548 
RANKP1 = RANK + 1 CHE 1558 

C LEVEL 2. CHE 156 
LEV = 2 CHE 1579 

C DETERMINE THE VECTOR TO ENTER THE BASTS CHE 1588 
D = TOL CHE 1590 

DO 170 J=RANKP1,M CHE 1600 

DD = ABS(A(NP2,J)) CHE 1619 

IF (DD.LE.D) GO TO 170 CHE 1628 

PCOL = J CHE 1638 

D = DD CHE 1648 

178 CONTINUE CHE 1659 

C COMPARE CHEBYSHEV ERROR WITH TOL. CHE 1660 
IF (D.GT.TOL) GO TO 1886 CHE 1670 
RESMAX = Q. CHE 1689 

MODE = 3 CHE 1690 

GO TO 389 CHE 1700 

180 IF (A(NP2,PCOL).LT.-TOL) GO TO 2080 CHE 17180 
A(NP1,PCOL) = 2. - A(NP1,PCOL) CHE 1720 

DO 199 I=NP1MR,NP3 CHE 1730 

IF (I.EQ.NP1) GO TO 196 CHE 1740 
A(I,PCOL) = -A(I,PCOL) CHE 175@ 

196 CONTINUE CHE 1768 

C ARRANGE FOR ALL ENTRIES IN PIVOT COLUMN CHE 1772 
C (EXCEPT PIVOT) TO BE NEGATIVE. CHE 1780 
200 DO 228 I=NP1MR,N CHE 1798 
IF (A(1I,PCOL).LT.TOL) GO TO 220 CHE 1868 

DO 210 J=1,™M CHE 1819 
A(NP1,J) = A(NP1,J) + 2.*A(I,J) CHE 1829 

A(I,J) = -A(I,dJ) CHE 1830 

210 CONTINUE CHE 1848 
A(I,MPl) = ~A(I,MP1) CHE 1858 

22@ CONTINUE CHE 1868 
PROW = NP1l CHE 1870 

GO TO 330 CHE 1880 

230 IF (RANKP1.EG.M) GO TO 380 CHE 1896 
IF (PCOL.EQ.M) GO TO 250 CHE 1900 

C INTERCHANGE COLUMNS IN LEVEL 2. CHE 1918 
DO 246 I=NP1MR,NP3 CHE 1920 

D = A(I,PCOL) CHE 1930 
A(I,PCOL) = A(I,M) CHE 1946 

A(I,M) = D CHE 1958 

248 CONTINUE CHE 19690 
256 MM1l = M - 1 CHE 1979 

C LEVEL 3. CHE 1988 
LEV = 3 CHE 1998 

C DETERMINE THE VECTOR TO ENTER THE BASIS. CHE 2068 
260 D = -TOL CHE 2018 
VAL = 2.*A(NP2,M) CHE 2020 

DO 280 J=RANKP1,MM1 CHE 2030 

IF (A(NP2,J).GE.D) GO TO 278 CHE 2040 

PCOL = J CHE 2050 

D = A(NP2,J) CHE 2068 

MODE = @ CHE 2076 

GO TO 286 CHE 20808 

270 DD = VAL - A(NP2,J) CHE 26986 
IF (DD.GE.D) GO TO 288 CHE 2100 

MODE = 1 CHE 2118 

PCOL = J CHE 2120 

D = DD CHE 2130 

280 CONTINUE CHE 2148 
IF (D.GE.-TGL) GO TO 380 CHE 2150 

DD = -D/A(NP2,M) CHE 2160 

IF (DD.GE.RELTMP) GO TO 296 CHE 2170 
RELERR = DD CHE 2180 

MODE = 4 CHE 2198 

GO TO 388 CHE 2200 

290 IF (MODE.EQ.8@) GO TO 319 CHE 2210 
DO 38@ I=NP1MR,NP1 CHE 2220 
A(I,PCOL) = 2.*A(I,M) - A(I,PCOL) CHE 2230 

308 CONTINUE CHE 2240 
A(NP2,PCOL) = D CHE 2250 
A(NP3,PCOL) = -A(NP3,PCOL) CHE 2268 

C DETERMINE THE VECTOR TO LEAVE THE BASIS. CHE 2270 
318 D = BIG CHE 2288 
DO 320 I=NP1MR,NP1 CHE 2290 

IF (A(I,PCOL).LE.TOL) GO TO 3290 CHE 2380 

DD = A(I,M)/A(1I,PCOL) CHE 2319 

IF (DD.GE.D) GO TO 320 CHE 2320 

PROW = I CHE 2330 

D = DD CHE 2340 

320 CONTINUE CHE 2350 
IF (D.LT.BIG) GO TO 338 CHE 2360 
OCODE = 2 CHE 2370 

GO TO 386 CHE 2388 

C PIVOT ON A(PROW,PCOL). CHE 2398 
33@ PIVOT = A(PROW,PCOL) CHE 2408 
DO 34@ J=1,M CHE 2416 


A(PROW,J) = A(PROW,J)/PIVOT CHE 2420 
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349 CONTINUE 
IF PERMITTED, USE SUBROUTINE COL IN THE DESCRIPTION 
SECTION AND REPLACE THE FOLLOWING EIGHT STATEMENTS DOWN TO 
AND INCLUDING STATEMENT NUMBER 368 BY.. 
DO 360 J=1,M 
IF(J.EQ.PCOL) GO TO 369 
CALL COL (A(1,J),A(1,PCOL) ,A(PROW,J) ,PROW,NPIMR,NP2) 
360 CONTINUE 
DO 360 J=1,M 
IF (J.EQ.PCOL) GO TO 368 
D = A(PROW,J) 
DO 350 I=NP1MKk,NP2 
IF (I.EQ.PROW) GO TO 350 
A(I,J) = A(I,J) - D*A(I,PCOL) 
358 CONTINUE 
360 CONTINUE 
TPIVOT = -PIVOT 
DO 370 I=NP1MR,NP2 
A(I,PCOL) = A(1I,PCOL)/TPIVOT 
370 CONTINUE 


A(PROW,PCOL) = 1./PIVOT 
D = A(PROW,MP1) 
A(PROW,MP1) = A(NP3,PCOL) 
A(NP3,PCOL) = D 


ITER = ITER + 
GO TO (110, 2 
PREPARE OUTPUT. 
38@ DO 398 J=1,M 
B(J) = @. 
398 CONTINUE 
IF (MODE.EQ.2) GO TO 459 
DO 480 J=1,RANK 
K = A(NP3,J) 
X(K) = A(NP2,J) 
400 CONTINUE 
IF (MODE.EQ.3 .OK. RANK.EQ.M) GO TO 459 
DO 41@ I=NP1MR,NP1 
K = AbBS(A(I,MP1)) - FLOAT(N) 
B(K) = A(NP2,M) *SIGN(1.,A(I,MP1)) 
416 CONTINUE 
IF (RANKP1.EQ.M) GO TO 438 
DO 420 J=RANKP1,MM1 
K = ABS(A(NP3,J)) - FLOAT(N) 
B(K) = (A(NP2,M)-A(NP2,J))*SIGN(1.,A(NP3,J)) 
420 CONTINUE 
TEST FOR NON-UNIQUE SOLUTION. 
430 DO 448 I=NF1IMR,NP1 
IF (ABS(A(I,M)).GT.TOL) GO TO 4468 
OCGDE = @ 
GO TO 456 
44@ CONTINUE 
450 IF (MODE.NE.2 .AND. MODE.NE.3) RESMAX = A(NP2,M) 
IF (RANK.EQ.M) RESMAX = @. 
IF (MODE.EQ.4) RESMAX = RESMAX - D 
RETURN 
END 
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DESCRIPTION 


The program given here is an implementation of the LZ algorithm [1 ] for finding 
x and ) such that Ax = \Bx, where A and B are n X n matrices. The LZ algorithm 
does not require matrix inversion and may be used when either or both matrices are 
singular. It is a generalization of Rutishauser’s LR method [3] for the standard 
eigenvalue problem Ax = dx and closely resembles the QZ algorithm given by 
Moler and Stewart [2] for the generalized problem given above. Since the LZ 
algorithm uses elementary transformations and the QZ algorithm uses orthogonal 
transformations, the LZ algorithm is probably more efficient when either A or B 
is complex. 

The LZ algorithm is based on three observations: 

(1) If L and M are nonsingular matrices, the eigenvalue problems LAMy = 
ALBMy and Ax = Bx have the same eigenvalues and their eigenvectors are 
related by x = My. | 

(2) If A is a triangular matrix with diagonal elements a; , and B is a triangular 
matrix with diagonal elements 6;, then for each 7, 7 = 1,2,..., 7, a:/@; is an 
eigenvalue of the generalized problem if 6; ¥ 0. 

(3) There exist matrices L and M such that LAM and LBM are upper tri- 
angular and L and M are the products of lower triangular and permutation matrices. 

The aim of the LZ algorithm is to find the matrices Z and M which reduce A 
and B simultaneously to triangular form. It accomplishes this aim in two phases. 

(1) The first phase simultaneously reduces A to upper Hessenberg form (i.e. 
a;,; = Ofor? > 7) and B to upper triangular form by (a) reducing B to triangular 
form as in Gaussian elimination and applying the transformations to A, and (b) 
reducing A to upper Hessenberg form while preserving the triangularity of B by 
using row transformations to zero the elements below the subdiagonal of A and 
column transformations to zero the subdiagonal elements of B introduced by the 
row transformations. 

(2) The second phase iteratively reduces A to upper triangular form while 
preserving the triangularity of B where each iteration is given by (a) finding a 
shift \,, (b) finding a stabilized transformation L;, such that L,(Az — %Bz) is 
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upper triangular, (c) finding a stabilized transformation M, such that L,B,M/; is 
upper triangular, (d) setting Ary, = L,A,M, and Bry = L,BeM;,. 

If L, and M;, are constructed appropriately, A;41 will be upper Hessenberg and 
hopefully some of its subdiagonal elements will be small enough to be considered 
zero. 

The shift \, is used to hasten the convergence of the algorithm. In practice it is 
set to the solution of the lowest 2 X 2 subproblem on the diagonal of A, — By, 
which has not been triangularized. 

Each matrix L, is a product of matrices Lyn—-1Len-2..- Lol. and each M;, is 
a product of matrices MiiMio...Min1+, where each L,,, and each M,,; is a 
stabilized elementary transformation (see [4]). The matrix L,, is designed to 
annihilate the (2,1) element of A, — \.B,. For 7 > 1, My,; zeros the ith sub- 
diagonal element of B introduced by Z,;, and for 7 > 1, Ix,; zeros the 
(¢ + 1,7 — 1)-th element of A introduced by M,,;-1. 

The LZ algorithm determines the eigenvectors of the problem by computing the 
eigenvectors of the triangularized A and B and multiplying them by the product of 
all the column transformations. 

The Fortran program given here is designed to find the eigénsystem for two 
complex matrices A and B and consists of two subroutines which must be called 
separately. A user should first issue a call to LZHES to reduce A to upper Hessen- 
berg form and B to triangular form and then issue a call to LZHES to determine the 
eigensystem of the reduced matrices. If A and B have already been reduced to 
Hessenberg and triangular form, then calling LZHES is unnecessary. In this 
situation, if eigenvectors are requested, the matrix X should be set to the identity 
matrix. The subroutine LZIT does not return the eigenvalues of the problem but the 
diagonal elements of the triangularized matrices. The 7th eigenvalue may be found 
by dividing EIGA(z) by EIGB(2). The user is warned that EIGB(z) may be zero. 
The eigenvectors produced by LZIT are normalized so that the modulus of their 
largest component is 1. 

Entrance to LZHES is attained by the statement 


CALL LZHES(N,A,NA,B,NB,X,NX,WANTX) 


where the input parameters are 


N order of the A and B matrices, 

A n X n complex matrix, 

NA row dimension of A, 

B n X n complex matrix, 

NB row dimension of B, 

NX row dimension of X (see output parameters) 


WANTX logical variable which should be set to . TRUE. if eigenvectors are 
wanted and otherwise set to .FALSE., 


and the output parameters are 


A complex upper Hessenberg matrix; the original A matrix is destroyed, 

B-complex upper triangular matrix; the original B matrix is destroyed, 

xX mn Xn complex array containing the transformations needed te compute the 
eigenvectors of the problem if WANTX was .TRUE. . 


Entrance to LZIT is attained by the statement 
CALL LZIT(N,A,NA,B,NB,X,NX,WANTX,ITER,EIGA,EIGB) 


where the input parameters are 


N order of the A and B matrices, 

A m X n complex upper Hessenberg matrix, 
NA row dimension of the A matrix, 

B n X n complex upper triangular matrix, 
NB row dimension of the B matrix, 


x n X n complex array containing the transformations to determine the 
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eigenvectors of the original problem if WANTX has been set to 
.TRUE. , 

NX row dimension of the X matrix, 

WANTX logical variable which should be set to .TRUE. if eigenvectors are 
wanted and otherwise set to .FALSE. , 


and the output parameters are 


xX n X n complex array whose 7th column contains the 7th eigenvectors if 
WANTX was set to .TRUE. , 

ITER integer array of length n whose 7th entry contains the number of iterations 
needed to find the 7th eigenvalue; for any 2, if iter(¢) = —1, then after 30 
iterations there was not a sufficient decrease in the last subdiagonal element 
of A to continue iterating so that not all the eigenvalues have been isolated, 

EIGA complex array of length n containing the diagonal of the triangularized A, 

EIGB complex array of length n containing the diagonal of B. 


Since | x |, where z is a complex scalar, must be computed at least 8n times per 
iteration, the execution time of the method is dependent on the algorithm used to 
compute | x |. Replacing the true modulus by an approximation has little effect on 
the numerical properties but may result in a significantly more efficient code. 
Several versions of the LZ algorithm with different methods for computing | x | 
were run on the IBM 360 model 67 with the Fortran H compiler opt=2. The 
results were interesting: 

(1) The procedure CABS supplied by the manufacturer to compute | «| was 
by far the slowest. 


THE MATRIX A; 


-238+ -344I1 86+ 1781 164+ 2461 -166+ -3681 56+ 1581 
76+ 1521 -96+ -1281 40+ -321 60+ 1841 -66+ -1361 
118+ 2841 55+ -182I -13+ 4601 34+ -192I -176+ -2141 
—-314+ -166I1 132+ 781 114+ 2961 -96+ -164I1 -424+ -374I1 
—54+ -241 -205+ -A4AGOI 189+ 1481 158+ 3121 -38+ -961 


THE MATRIX B: 


388+ 941 -386+ -122I1 -250+ -141 556+ 13@1 -396+ -62I1 
-304+ -761 384+ 641 -160+ 161 -240+ -92I 240+ ‘681 
-658+ -1361 -73+ 101 -1694+ -2501 -118+ 19@I 406+ 961 
-640+ -16I1 204+ -421 -692+ -901 288+ 661 -192+ 1541 


-162+ -721 631+ 1581 131+ 521 -758+ -184I1 278+ 761 


TRUE EIGENVALUE 


1 7.64760588235294E-01+ 9.4117647858823E-@1 I 
2 -1. GBB O08B00B0BGE+00+ -1.3333333333333E+00 I 
3 -3.5294117647059E-61+ -4.1176476588235E-01 I 
4 -3.5294117647059E-61+ -4.1176470588235E-@1 I 
5 -3.5294117647959E-O1+ 4.1176476588235E-61 I 
ALPHA 
1 -3.1059278860929E+02+ -1.2388967798794E+63 I 
2 3.9432113620788E+81+ 1.8552048946044E+92 I 
3 3.43803578717787E+8 2+ 3.6267083487891E+61 I 
4 4.0331923195321E+61+ -4.1475768275521E+@2 I 
5 -2.6483984149765E+01+ -1.2383248679301E+62 I 
BETA 
1 -~9.5389018503961E+02+ —4.4503094594735E+02 I 
2 -1.8324539562850E+02+ -4.7859961955782E+01 I 
3 -4.6241674938452E+8 2+ 4.3672969795956E+82 I 
4 5.3226244802292E+92+ 5.5417391177970E+02 I 
5 -1.4158479653056E+6 2+ 1.8567644996121E+62 I 
COMPUTED EIGENVALUE 
1 7.6476588235296E-@01+ 9.4117647058821E-61 I 
2 -1. 98000800080 00E+00+ -1.3333333333333E+69 I 
3 -3.5294117647659E-01+ -4.1176470588233E-G1 I 
4 -3.5294117647058E-61+ -4.1176479588236E-61 I 
5 -3.5294117647058E-01+ 4.1176470588232E-61 I 
RELATIVE ERROR RELATIVE RESIDUAL NO. OF ITERATIONS 
1 2.7609971587330E-14 4.3138589276375E-15 © 8 
2 6.8291556413457E-15 6.7886927362343E-15 1 
3 3.9441522601135E-14 2.9742630452889E-15 7) 
4 1.1809767464717E-14 6.08575938618225E-15 3 
5 5.6542864065059E-14 8.3880870692588E-15 1 


Fig. 1 
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(2) Substituting the procedure RABS given by 
REAL FUNCTION RABS(X) 
COMPLEX X, XX 
- REAL TQ) 
EQUIVALENCE (XX, T(1)) 
XX =X 
RABS = ABS(T(1)) + ABS(T(2)) 
RETURN 
END 
for CABS decreased the time by about 20 percent when no eigenvectors were 
computed. When using RABS, changing the precision of the program requires very 
little effort. 

(3) Computing |2| as ABS(REAL(X)) + ABS(AIMAG(X)) as in the 
program given here decreased execution times from version 2 by roughly 10 percent 
when no eigenvectors were computed. 

Although theoretically numerical growth can be quite large, our experiments 
have shown that the algorithm behaves like most other methods which use sta- 
bilized elementary transformations: numerical growth rarely occurs and errors 
rarely accumulate. The eigenvalues are usually determined to the accuracy justified 

- by the condition of the problem. 

The example shown in Figure 1 was generated in integer arithmetic by multiplying 
two diagonal matrices by nonsingular transformations. It was run on the CDC 
Run compiler. The relative residual is the quantity, 


|| B:Ax: — oBx: || / (II Be | I] A [lo + [foe Il [| B lee) 


where a; and @; are the 7th diagnonal elements of the triangularized A and B matrices 
and x; is the 7th eigenvector. 
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ALGORITHM 
SUBROUTINE L2HES(N, A, NA, B, NB, X, NX, WANTX) L2H 10 
C THIS SUBROUTINE REDUCES THE COMPLEX MATRIX A TO UPPER LZH 28 
C HESSENBERG FORM AND REDUCES THE COMPLEX MATRIX B TO L2H 30 
C TRIANGULAR FORM L2H 40 
C .INPUT PARAMETERS... LZH 56 
CN THE ORDER OF THE A AND B MATRICES L2H 60 
CA A COMPLEX MATRIX LZH 70 
C NA THE ROW DIMENSION OF THE A MATRIX LZH 88 
Cc B A COMPLEX MATRIX L2H 90 
C NB THE ROW DIMENSION OF THE B MATRIX LZH 1890 
C NX THE ROW DIMENSION OF THE X MATRIX LZH 1180 
C WANTX A LOGICAL VARIABLE WHICH IS SET TO .TRUE. IF LZH 120 
Cc THE EIGENVECTORS ARE WANTED. OTHERWISE IT SHOULD LZH 136 
c BE SET TO .FALSE. LZH 146 
C OUTPUT PARAMETERS.. LZH 156 
C A ON OUTPUT A IS AN UPPER HESSENBERG MATRIX, THE LZH 160 
Cc ORIGINAL MATRIX HAS BEEN DESTROYED LZH 1798 
C B AN UPPER TRIANGULAR MATRIX, THE ORIGINAL MATRIX LZH 186 
Cc HAS BEEN DESTROYED LZH 196 
C X CONTAINS THE TRANSFORMATIONS NEEDED TO COMPUTE LZH 2008 
Cc THE EIGENVECTORS OF THE ORIGINAL SYSTEM LZH 219 
COMPLEX Y, W, Z, A(NA,N), B(NB,N), X(NX,N) LZH 220 
REAL C, D LZH 238 
LOGICAL WANTX L2H 249 
NM1 = N - 1 LZH 256 
C REDUCE B TO TRIANGULAR FORM USING ELEMENTARY L2H 2690 
C TRANSFORMATIONS LZH 278 
DO 88 I=1,NM1 LZH 286 


D = 0.00 LZH 296 
IPl=I+1 LZH 380 
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DO 18 K=IP1,N 
Y = B(K,TI) : 
C = ABS(REAL(Y)) + ABS (AIMAG(Y) ) 
IF (C.LE.D) GO TO 120 
D=C 
Ii = K 
18 CONTINUE 
IF (D.EQ.0.0) GO TO 8@ 
Y = B(I,1) 
IF (D.LE.ABS(REAL(Y))+ABS(AIMAG(Y))) GO TO 46 
C MUST INTERCHANGE 
DO 28 J=1,N 
Y = A(I,d) 
A(I,J) = A(II,d) 
A(II,J) = Y 
20 CONTINUE 
DO 3@ J=I,N 
Y = B(I,Jd) 
B(I,J) = B(II,J) 
B(II,J) = ¥Y 
30 CONTINUE 
42 DO 70 J=IP1,N 
Y = B(J,1I)/B(I,1) 
IF (REAL(Y).EQ.0.@ .AND. AIMAG(Y) .EQ.%.8) GO TO 78 
DO 58 K=1,N 
A(J,K) = A(J,K) - Y*A(I,K) 
58 CONTINUE 
DO 60 K=IP1,N 
B(J,K) = B(J,K) - Y*B(I,K) 
60 CONTINUE 
70 CONTINUE 
B(IP1,1I) = (@.0,0.0) 
&6&@ CONTINUE 
C INITIALIZE X 
IF (.NOT.WANTX) GO TO 118 
DO 10@ I=1,N 
DO 90 J=1,N 
X(I,J) = (@.0,0.@) 
96 CONTINUE 
X(I,I) = {1.0,0.08) 
10@ CONTINUE 
C REDUCE A TO UPPER HESSENBERG FORM 
11@ NM2 = N - 2 
IF (NM2.LT.1) GO TO 279 
DO 260 J=1,NM2 
JM2 = NM1 - J 
JPl=dJ+41 
DO 25@ II=1,JM2 
I = II 
IM1l 
IMJ 
w = A(I,J) 
Z = A(IMI1,d) 
IF (ABS (REAL(W) ) +ABS (AIMAG(W) ) .LE.ABS (REAL (Z) ) 
* +ABS (AIMAG(Z))) GO TO 148 
C MUST INTERCHANGE ROWS 
DO 12@ K=J,N 
Y = A(I,K) 
A(I,K) = A(IM1,K) 
A(IM1,K) = Y 
126 CONTINUE 
DO 138 K=IM1,N 
Y = B(I,K) 
B(I,K) = B(IMI1,K) 
B(IM1,K) = Y 
136 CONTINUE 
140 Z = A(I,J) 
IF (REAL(2Z).EQ.0.@ .AND. AIMAG(Z).EQ.0.08) GO TO 178 
Y = 2/A(IM1,Jd) 
DO 15@ K=JP1,N 
A(I,K) = A(I,K) - Y*A(IM1,K) 
150 CONTINUE 
DO 16@ K=IM1,N 
B(I,K) = B(I,K) - Y*B(IM1,K) 


Houa 
te 


169 CONTINUE 
C TRANSFORMATION FROM THE RIGHT 
170 Ww = B(I,IM1) 
Z = B(I,1) 
IF (ABS(REAL(W) ) +ABS (AIMAG(W) ) .LE.ABS (REAL (2) ) 
ig +ABS (AIMAG(Z))) GO TO 218 


C MUST INTERCHANGE COLUMNS 
DO 188 K=1,1 
¥Y = B(K,I) 
B(K,I) = B(K,IM1) 
B(K,IM1) = Y 


186 CONTINUE 
DO 19@ K=1,N 
Y = A(K,1) 
A(K,1I) = A(K,IM1) 
A(K,IM1) = Y 
198 CONTINUE 


IF (.NOT.WANTX) GO TO 218 
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COLLECTED ALGORITHMS (cont.) 


AOORAAAOCHAABAAOAON AON Ae AAA AAA AkKAOH 


DO 200 K=IMJ,N 


Y = X(K,1I) 
X(K,I) = X(K,IM1) 
X(K,IM1) = Y 

206 CONTINUE 

218 2 = B(I,IM1) 


IF (REAL(Z).EQ.@.0 .AND. AIMAG(Z).EQ.8.9) GO TO 259 
Y = 2/B(1,1) 
DO 220 k=1.IM1 

B(K,IM1) = B(K,IM1) - Y*B(K,I) 


220 CONTINUE 
B(I,IM1) = (0.0,0.0) 
DO 2306 K=1,N 
A(K,IM1) = A(K,IM1) - Y*A(K,I) 
236 CONTINUE 


IF (.NOT.WANTX) GO TO 256 
DO 240 K=IMJ,N 
X(K,IM1) = X(K,IM1) - Y*X(K,I) 
246 CONTINUE 
250 CONTINUE 
A(JP1+1,J) = (@.0,0.0) 
260 CONTINUE 
27@ RETURN 
END 


-SUBROUTINE LZIT(N, A, NA, B, NB, X, NX, WANTX, ITER, EIGA, 
* EIGB) 
THIS SUBROUTINE SOLVES THE GENERALIZED EIGENVALUE PROBLEM 
A X = LAMBDA B X 
WHERE A IS A COMPLEX UPPER HESSENBERG MATRIX OF 
ORDER N AND B IS A COMPLEX UPPER TRIANGULAR MATRIX OF ORDER N 
INPUT PARAMETERS 


N ORDER OF A AND B 

A AN N X N UPPER HESSENBERG COMPLEX MATRIX 

NA THE ROW DIMENSION OF THE A MATRIX 

B AN N X N UPPEK TRIANGULAR COMPLEX MATRIX 

NB THE ROW DIMENSION OF THE B MATRIX 

x CONTAINS TRANSFORMATIONS TO OBTAIN EIGENVECTORS OF 


ORIGINAL SYSTEM. IF EIGENVECTORS ARE REQUESTED AND QZHES 
IS NOT CALLED, X SHOULD BE SET TO THE IDENTITY MATRIX 
NX THE ROW DIMENSION OF THE X MATRIX 
WANTX LOGICAL VARIABLE WHICH SHOULD BE SET TO .TRUE. 
IF EIGENVECTORS ARE WANTED. OTHERWISE IT 
SHOULD BE SET TO .FALSE. 
OUTPUT PARAMETERS 
x THE ITH COLUMN CONTAINS THE ITH EIGENVECTOR 
IF EIGENVECTORS ARE REQUESTED 
ITER AN INTEGER ARRAY OF LENGTH N WHOSE ITH ENTRY 
CONTAINS THE NUMBER OF ITERATIONS NEEDED TO FIND 
THE ITH EIGENVALUE. FOR ANY I IF ITER(I) =-1 THEN 
AFTER 3@ ITERATIONS THERE HAS NOT BEEN A SUFFICIENT 
DECREASE IN THE LAST SUBDIAGONAL ELEMENT OF A 
TO CONTINUE ITERATING. 
EIGA A COMPLEX ARRAY OF LENGTH N CONTAINING THE DIAGONAL OF A 
EIGB A COMPLEX ARRAY OF LENGTH N CONTAINING THE DIAGONAL OF B 
THE ITH EIGENVALUE CAN BE FOUND BY DIVIDING EIGA(I) BY 
EIGB(I). WATCH OUT FOR EIGB(I) BEING ZERO 
COMPLEX A(NA,N), B(NB,N), EIGA(N), EIGB(N) 
COMPLEX S, W, Y, 2, CSQRT 
COMPLEX X(NX,N) 
INTEGER ITER(N) 
COMPLEX ANNM1, ALFM, BETM, D, SL, DEN, NUM, ANMIML 
REAL EPSA, EPSB, SS, R, ANORM, BNORM, ANI, BNI, C 
REAL D@, Dl, D2, EO, El 
LOGICAL WANIX 
NN = N 


C COMPUTE THE MACHINE PRECISION TIMES THE NORM OF A AND B 


ANORM = @. 
BNORM = @. 
DO 3@ I=1,N 
ANI = @. 
IF (1.EQ.1) GO TO 18 
Y = A(I,I-1) 
ANI = ANI + ABS(REAL(Y)) + ABS (AIMAG(Y) ) 
10 BNI = @. 
DO 28 J=I,N 
ANI = ANI + ABS(REAL(A(I,J))) 
BNI = BNI + ABS(REAL(B(I,J))) 
20 CONTINUE 
IF (ANI.GT.ANORM) ANORM = ANI 
IF (BNI.GT.BNORM) BNORM = 
3@ CONTINUE 
IF (ANORM.EQ.@.) ANORM 
IF (BNORM.EQ.@.) BNORM 
EPSB BNORM 
EPSA ANOKM 
40 EPSA EPSA/2.9 
EPSB EPSB/2.0 
C = ANORM + EPSA 
IF (C.GT.ANORM) GO TO 48 
IF (N.LE.1) GO TO 328 


ABS (AIMAG(A(I,J))) 


+ 
+ ABS (AIMAG(B(I,J))) 
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COLLECTED ALGORITHMS (cont.) 


NM1 = NN - 1 


C CHECK FOR NEGLIGIBLE SUBDIAGONAL ELEMENTS 


AAD 


68 


70 


88 


96 


D2 = ABS(REAL(A(NN,NN))) + ABS (AIMAG(A(NN,NN) )) 
DO 76 LB=2,NN 
L = NN + 2 = LB 


Y = A(L-1,L-1) 

D2 = ABS(REAL(Y)) + ABS (AIMAG(Y) ) 

SS = SS + D2 

Y = A(L,L-1) 

R = SS + ABS(REAL(Y)) + ABS (AIMAG(Y) ) 
IF (R.EQ.SS) GO TO 88 

CONTINUE 

L=1 

IF (L.EQ.NN) GO TO 320 

IF (ITS.LT.36) GO TO 99 

ITER(NN) = -1l 

IF (ABS (REAL(A(NN,NM1)))+ABS (AIMAG(A(NN,NM1))) .GT.@.8* 


* ABS (REAL (ANNM1) ) +ABS (AIMAG(ANNM1))) RETURN 


IF (I1S.EQ.1@ .OR. ITS.EQ.20) GO TO 116 


COMPUTE SHIFT AS EIGENVALUE OF LOWER 2 BY 2 


100 


ANNM1 = A(NN,NM1) 
ANM1mM1 = A(NM1,NM1) 


S = A(NN,NN)*B(NM1,NM1) - ANNM1*B(NM1,NN) 

W = ANNM1*B(NN,NN) * (A(NM1,NN)*B(NM1,NM1) -B(NM1,NN) *ANMIM1) 
Y = (ANMI1M1*B(NN,NN)-S)/2. 

2 = CSQRT(Y*Y+W) 


IF (REAL(Z).EQ.0.@ .AND. AIMAG(Z).EQ.@.8) GO TO 180 
D@ = REAL(Y/Z) 

IF (D@.LT.@.0) 2 = -2 

DEN = (Y+Z)*B(NM1,NM1) *B(NN,NN) 

IF (REAL(DEN) .EQ.@.@ .AND. AIMAG(DEN) .EQ.@.@) DEN = 


* CMPLX(EPSA,9.0) 


NUM = (Y¥+Z)*5 - W 
GO TO 128 


AD-HOC SHIFT 


110 


Y = A(NM1,NN~-2) 


NUM = CMPLX(ABS (REAL (ANNM1) ) +ABS (AIMAG (ANNM1) ) , ABS (REAL (Y) ) 
* +ABS (AIMAG(%) )) 


DEN = (1.0,0.8) 


CHECK FOR 2 CONSECUTIVE SMALL SUBDIAGONAL ELEMENTS 


136 
149 
150 


IF (NN.EQ.L+1) GO TO 148 


D2 = ABS(REAL(A(NM1,NM1))) + ABS (AIMAG(A(NM1,NM1) )) 
El = ABS(REAL(ANNM1)) + ABS (AIMAG(ANNM1) ) 

D1 = ABS(REAL(A(NN,NN))) + ABS(AIMAG(A(NN,NN))) 

NL = NN - (L+1) 


DO 13@ MB=1,NL 
M = NN — MB 
EO = El 
Y = A(M,M-1) 


El = ABS(REAL(Y)) + ABS(AIMAG(Y) ) 
DQ = Dl 
Dl = D2 


Y = A(M-1,M-1) 

ABS (REAL(Y)) + ABS(AIMAG(Y) ) 

Y = A(M,M)*DEN - B(M,M) *NUM 

(DG+D14+D2) * (ABS (REAL (Y) ) +ABS (AIMAG(Y))) 
E® = E®*E1* (ABS(REAL(DEN))+ABS(AIMAG(DEN))) + D@ 
IF (E®.EQ.D@) GO TO 150 

CONTINUE 

M=L 

CONTINUE 

Ivs = ITS + 1 

Ww = A(M,M)*DEN - B(M,M)*NUM 

Z = A(M+1,M) *DEN 

Dl = ABS(REAL(Z)) + ABS (AIMAG(Z)) 

D2 = ABS(REAL(W)) + ABS(AIMAG(W) ) 


oO 
N 
u 


iw) 
S 
nou 


FIND L AND M AND SET A=LAM AND B=LBM 


168 


NPl = N+ 1 


LORI = L 
NNORN = NN 
IF (.NOT.WANTX) GO TO 166 
LOR] = 1 
NNOKN = N 
DQ 316 I=M,NM1 
Js=I+1]1 


FIND KOW TRANSFORMATIONS TO RESTORE A TO 
UPPER HESSENBERG FORM. APPLY TRANSFORMATIONS 
TO A AND B 


1706 


IF (I.EQ.M) GO TO 178 

= A(I,I-1) 

= A(J,I-1) 

1 ABS (REAL(Z)) + ABS (AIMAG(2Z) ) 
D2 ABS (REAL(W)) + ABS (AIMAG (W) ) 
IF (D1.EQ.9.8) GO TO 6@ 

IF (D2.GT.D1) GO TO 198 


W 
Z 
D 


MUST INTERCHANGE ROWS 


DO 18@ K=I,NNORN 


Y = A(I,K) 
A(I,K) = A(J,K) 
A(J,K) = ¥ 


Y = B(I,K) 
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679 
689 
690 
7008 
716 
720 
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746 
7568 
768 
770 
788 
7390 
880 
818 
828 
830 
840 
858 
868 
878 
880 
898 
9606 
910 
920 


930 . 


948 

950 

968 

972 

980 

998 
1000 
1019 
1020 
1638 
10408 
1058 
1868 
1078 
1686 
1690 
1100 
1110 
1120 
113@ 
1140 
1158 
1168 
1170 
1186 
1198 
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1210 
1220 
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1240 
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1270 
1286 
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1300 
1310 
1320 
1334 
1340 
1350 
13698 
1370 
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1390 
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1458 
1460 
1476 
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1496 
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1514 
1528 
1538 
154@ 
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1576 
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COLLECTED ALGORITHMS (cont.) 


AAD 


a 


B(I,K) = B(J,K) 
B(J,K) = Y 
168 CONTINUE 


IF (1.GT.M) 
IF (D2.EQ.0.@) 


A(I,I-1) = A(J,I-1) 
GO TO 220 


THE SCALING OF W AND Z IS DESIGNED TO AVOID A DIVISION BY ZERO 
WHEN THE DENOMINATOR IS SMALL 
Y = CMPLX(REAL(W)/D1,AIMAG(W) /D1) /CMPLX (REAL (Z)/D1,AIMAG(2)/ 
7 D1) 
GO TO 208 
190 Y = CMPLX(REAL(2)/D2,AIMAG(2Z)/D2) /CMPLX (REAL (W) /D2,AIMAG (W) / 
i D2) 
206 DO 210 K=1,NNORN 
A(J,K) = A(J,K) - Y*A(T,K) 
B(J,K) = B(J,K) - Y*B(I,K) 
2106 CONTINUE 
IF (I.GT.M) A(J,I-1) = (0.0,0.0) 
PERFORM TRANSFORMATIONS FROM RIGHT TO RESTORE B TO 
TRIANGLULAR FORM 
APPLY TRANSFORMATIONS TO A 
226 2 = B(J,I) 
W = B(J,J) 


D2 = ABS(REAL(W)) + ABS (AIMAG (W) ) 
D1 = ABS(REAL(Z)) + ABS (AIMAG(Z) ) 
IF (D1.EQ.0.8) GO TO 69 
IF (D2.GT.D1) GO TO 276 

MUST INTERCHANGE COLUMNS 

DO 23@ K=LORI1,Jd 

Y = A(K,J) 

A(K,Jd) = A(K,1I) 

A(K,I1I) = Y 

Y = B(K,J) 

B(K,J) = 
B(K.I) = Y 

CONTINUE 

IF (1.EQ.NM1) GO TO 246 

Y = A(J+1,J) 

A(J+1,J) = A(J+t+1,T1) 

A(Jt+l,1I) = Y¥ 

IF (.NOT.WANTX) GO TO 268 

DO 25@ K=1,N 
¥Y = X(K,J) 

X(K,J) = 
X(K,I) = Y 
CONTINUE 
IF (D2.EQ.@.8) GO TO 310 
a = CMPLX (REAL (W) /D1,AIMAG(W) /D1) /CMPLX (REAL (2) /D1,AIMAG(Z)/ 
* D1) 

GO TO 280 
278 Z = CMPLX(REAL(Z)/D2,AIMAG(Z)/D2) /CMPLX (REAL(W) /D2,AIMAG (W) / 
* D2) 

DO 298 K=LORI1,J 
A(K,I) = A(K,I) 
B(K,I) = B(K,1) 

CONTINUE 

B(JdJ,1I) = (@.0,8.90) 

IF (1.LT.NM1) A(1I+2,I) = 

IF (.NOT.WANTX) GO TO 318 

DO 308 K=1,N 
X(K,I) = X(K,I) 

308 CONTINUE 
310 CONTINUE 
GO TO 60 
320 CONTINUE 
EIGA(NN) = A(NN,NN) 
EIGB(NN) = B(NN,NN) 
IF (NN.EQ.1) GO TO 3390 
ITER(NN) = ITS 
NN = NM1 
IF (NN.GT.1) 
ITER(1) = @ 
GO TO 320 
FIND EIGENVECTORS USING B FOR INTERMEDIATE STORAGE 
330 IF (.NOT.WANTX) RETURN 
M = N 
CONTINUE 
ALFM = A(M,M) 
BETM = B(M,M) 
B(M,M) = (1.8,8.@) 
L=M- 1 
IF (L.EQ.@) 
350 CONTINUE 
Ll =L+1 
SL = (8@.0,0.90) 
DO 3608 J=L1,M 
SL = SL + (BETM*A(L,J) -ALFM*B(L,J))*B(J,M) 
36@ CONTINUE 
Y = BETM*A(L,L) - ALFM*B(L,L) 
IF (REAL(Y).EQ.@.@ .AND. AIMAG(Y).EQ.9.0) Y = 

* CMPLX( (EPSA+EPSB)/2.0,0.6) 

B(L,M) = -SL/Y 
L=L-i1 


236 


240 


- Z*A(K,d) 
- Z*B(K,J) 


A(I+2,1) - 2*A(I+2,9) 


- Z2*X(K,J) 


GO TO 58 


340 


GO TO 378 


1600 
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16208 
16390 
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16698 
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1730 
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1776 
1788 
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2002 
2610 
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2180 
2196 
2208 
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2298 
2300 
2318 
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2360 
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2400 
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COLLECTED ALGORITHMS (cont.) 


370 IF (L.GT.@) GO TO 35% LZ1 2520 
M=M-1 LZI 2538 

IF (M.GT.@) GO TO 340 LZI 2540 

C TRANSFORM TO ORIGINAL COORDINATE SYSTEM LZI 2550 
M=N LZI 2560 

380 CONTINUE LZI 2570 
DO 490 I=1,N LZI 2588 

S = (0.0,0.0) LZI 2590 

DO 390 J=1,M L2ZI 2690 

S = S + X(I,J)*B(J,M) LZI 2610 

398 CONTINUE LZI 2620 
X(I,M) = 5 L2I 2636 

490 CONTINUE LZI 2640 
M=M- 1 LZI 2659 

IF (M.GT.@) GO TO 380 . LZI 2660 

C NORMALIZE SO THAT LARGEST COMPONENT = 1. LZI 2670 
M = N LZI 26880 
41 CONTINUE L2ZI 2690 
SS = @. L21I 2700 

DO 4206 I=1,N LZI 2718 

R = ABS(REAL(X(I,M))) + ABS{AIMAG(X(I,M))) LZI 2720 

IF (R.LT.SS) GO TO 420 LZI 2736 

SS = R L2Z1I 2740 

D = X(I,M) LZ2I 2750 

420 CONTINUE LZI 2760 
IF (SS.EQ.%.8) GO TO 449 L2I 2770 

DO 438 I=1,N LZI 2788 
X(I,M) = X(I,M)/D L2ZI 2790 

430 CONTINUE LZI 2800 
440 M=M-1] L2I 2810 
IF (M.GT.®) GO TO 410 LZI 2820 
RETURN LZI 2830 

END LZ1I 2840 


ACM Transactions on Mathematical Software, Vol. 2, No. 4, December 1976, Dage-- 396. 
REMARK ON ALGORITHM 496 


The LZ Algorithm to Solve the Generalized Eigenvalue Problem for Complex 
Matrices [F2] 


[L.C. Kaufman, ACM Trans. Math. Software 1, 3 (Sept. 1975) , 271-281] 


L.C. Kaufman [Reed 22 April 1976] 
Bell Laboratories, Murray Hill, NJ 07974. 


The following incorrect lines should be changed: 


from 
IF(.GT.M) A(J,I--1) = (0.0,0.0) LZI 1760 
220 Z=B(,I) LZI 1800 
to 
220 IF(I.GT.M) A(J,I~1) = (.0,0.0) LZI 1760 
Z=B(,I) LZI 1800 


The following unnecessary line should be deleted: 
NP1=N+41 LZI 1360 
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ALGORITHM 497 
Automatic Integration of Functional 


Differential Equations [D2] 


KENNETH W. NEVES 
Babcock & Wilcox 


Key Words and Phrases: functional differential equations, automatic integration, one-step 
and multistep methods, time lags and retarded arguments, Volterra integro-differential 
equations, derivative jump discontinuities 

CR Categories: 5.16, 5.17, 5.18 

Language: Fortran 


DESCRIPTION 


This algorithm is a complement to [1] where the theoretical background and 
development are described. 


REFERENCES 


1. Neves, K.W. Automatic integration of functional differential equations: an approach. ACM 
Trans. Math. Software 1, 4 (Dec. 1975), 357-368. 


ALGORITHM 

SUBROUTINE DMRODE(F, A, B, HMIN, H, HMAX, N, X@, WK, EPS, DMR 18 

* JSTART, AA, TT, XX, 22, FINIT, ALPHA, WKA, IER, IQ) DMR 28 
Cc DMR 38 
CF -AUTOMATIC STEP CHANGE MERSON DIFFERENTIAL EQUATION DMR 40 
Cc U - SOLVER MODIFIED TO HANDLE FUNCTIONAL DIFFERENTIAL DMR 58 
CN - EQUATIONS OF THE FORM | DMR 68 
(ome > (1) DX/DT =F(T,X,2Z,1) DMR 78 
Cc T - WHERE F (DESCRIBED BELOW) IS A VECTOR VALUED DMR 88 
Cc iI - FUNCTION OF DIMENSION N, X AND Z ARE DMR 98 
Cc Oo - N VECTORS SUCH THAT THE ITH COMPONENT OF Z IS DMR 188 
CN ~ THE ITH COMPONENT OF X EVALUATED AT ALPHA(X,T,I) DMR 116 
Cc - ALPHA IS A VECTOR VALUED FUNCTION (DESCRIBED DMR 128 
Cc - BELOW). ALPHA IS A USER SUPPLIED STATE DEPENDENT DMR 138 
Cc - RETARDING FUNCTION, AND (1) IS CALLED A DMR 1486 
Cc - RETARDED ORDINARY DIFF. EQ. (RODE) WITH STATE DMR 158 
Cc - DEPENDENT LAG (SDL). NOTE -AS WRITTEN ABOVE DMR 168 
Cc EACH COMPONENT OF DX/DT MAY DEPEND ON A DIFFERENT DMR 176 
Cc - RETARDING FUNCTION. IT IS ALSO POSSIBLE TO ALLOW DMR 188 
Cc - A GIVEN COMPONENT TO DEPEND ON MORE THAN ONE DMR 198 
Cc - RETARDING FUNCTION BY AUGMENTING THE ORDER OF DMR 260 
Cc - THE SYSTEM (SEE DISCRIPTION FOR DETAILS). DMR 216 
Cc P F-USER SUPPLIED EXTERNAL FUNCTION. THE DERIVATIVE DMR 220 
CA - OF THE ITH COMPONENT OF X IS F(T, X, Z,I), WHERE DMR 230 
C R - 2% AND X ARE ARRAYS OF DIMENSION N. X(I) DMR 248 
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COLLECTED ALGORITHMS (cont.) 


NAAN ANIANANDANDNANAANANDANANDNNDNNAD NANANANAANANANNANNNNNAANANRANANNNANANAANANNANANAANANAANNAANANNAANA 


aan 


A0A0Ga 


IS THE SOLUTION OF THE ITH COMPONENET AT T AND 
Z (I) IS THE ITH COMPONENT OF X AT ALPHA(X,T,I) 
Z(I) IS CALCULATED INTERNALLY WITHIN DMRODE AND 
PASSED TO F (SEE ALPHA BELOW). T IS THE CURRENT 
VALUE OF THE INDEPENDENT VARIABLE. 


A-STARTING POINT OF INTEGRATION 
B-FINAL POINT OF INTEGRATION (NOT NEC. .GT. A) 
HMIN-THE ABSOLUTE VALUE OF MINIMUM ALLOWABLE STEP SIZE 


NDMAM = yY 
' 


THE STEP SIZE WILL NEVER BE SMALLER THAN HMIN 
IN ABSOLUTE VALUE EXCEPT AT THE END OF THE 


-INTERVAL WHERE H IS ALWAYS .GT. HMIN/2 IN ABS.. 
H-INITIAL GUESS OF THE INTEGRATION STEP SIZE. THE 


ADJUSTED STEPSIZE IS RETURNED IN H. 


HMAX-THE ABSOLUTE VALUE OF MAXIMUM ALLOWABLE STEP SIZE 
N-NUMBER OF SIMULTANEOUS EQUATIONS 
X@8-VECTOR OF LENGTH N CONTAINING THE VALUE OF X(A). 


X(B) IS RETURNED IN x@. 


WK-WORK AREA OF DIMENSION .GE. 4*N 
EPS-INPUT REQUEST OF RELATIVE ERROR IN LARGEST COMP. 


JSTART-A 


PARAMETER USED TO INTIALIZE Z2 ARRAY INTERNALLY 

IN DMRODE. JSTART MUST BE SET EQUAL TO ZERO ON 
FIRST CALL TO DMRODE. TO INTEGRATE BEYOND B AFTER 
FIRST CALL CERTAIN ARRAYS MUST BE SAVED. THIS 

IS DONE AUTOMATICALLY BY LETTING JSTART=1. 


IF JSTART=-1, THEN THE INITIAL CONDITIONS AT 


THE PREVIOUS CALL ARE REINSTATED AND THE INTE- 
GRATION FROM A TO POSSIBLY A NEW CHOICE FOR B 
CAN BE EXECUTED. THIS ALLOWS INTERATIVE USE OF 
DMRODE IN ORDER TO CALCULATE DERIVATIVE JUMP 
POINTS IN THE SOLUTION(SEE DESCRIPTION) 
PARAMETER THAT MUST BE SET EQUAL TO THE VALUE OF 
THE STARTING POINT A WHEN FIRST CALL TO DMRODE 
WAS MADE (I.E. WHEN JSTART=@) (SEE FINIT) 


TT-STORAGE ARRAY FOR SAVING TIME STEP VALUES 


TT IS OF DIMENSION IQ WHERE IQ IS .GT.LENGTH OF 
ENTIRE INTERVAL/HMIN 


XX,ZZ-STORAGE ARRAYS OF DIMENSION N BY IQ USED FOR 


SAVING VALUES OF X AND Z DESCRIBED IN F. 


FINIT-USER SUPPLIED EXTERNAL FUNCTION, FINIT(T,I). FINIT 


RETURNS THE VALUE OF THE ITH COMPONENT OF 
THE INITIAL FUNCTION AT T WHENEVER ((T. LE.AA) 
.AND. (H.GE.@)) .OR. ((T.GE.AA) .AND. (H.LE.@)). 


ALPHA-USER SUPPLIED EXTERNAL FUNCTION OF THE 


FORM ALPHA(X,T,1I) WHERE X IS ASSUMED TO BE 

THE CURRENT SOLUTION (SUPPLIED BY DMRODE) AND 

T THE CURRENT TIME. IN GENERAL ALPHA WILL BE 
DIFFERENT FOR EACH COMPONENT X(I). IN THE EVENT 
A RODE IS POSED WITH MORE THAN ONE LAG IN ANY 
GIVEN COMPONENT THE SYSTEM MAY BE AUGMENTED TO 
HANDLE THIS SITUATION (SEE DISCRIPTION). 


WKA-WORK AKEA OF DIMENSION .GE.11*N UNLESS 


IT IS KNOWN THE LAG T-ALPHA(T,X(T),I) IN ALL 
COMPONENTS WILL ALWAYS EXCEED HMAX OR VANISH 
OVER THE ENTIRE INTERVAL IN A GIVEN COMPONENT, 
IN WHICH CASE A DIMENSION OF 3*N WILL SUFFICE 


IER-OUTPUT PARAMETER IF IER=6 AND HMAX.NE.HMIN 


NORMAL ERROR CHECKING TOOK PLACE. IF IER=1 
HMIN WAS ATTAINED BY THE STEP CHANGING 
PROCEDURE, HENCE REQUESTED ACCURACY IS NOT 
GUARANTEED 


IQ-THE DIMENSION OF TT IN THE CALLING PROGRAM (ALSO 


THE DIMENSION OF THE 2ND ARGUMENT OF THE XX AND 
ZZ ARRAYS). 


PRECISION - SINGLE 
AUTHOR/IMPLEMENTOR- KENNETH W. NEVES 
REQUIRED ROUTINES 
- DZETA, AN INTERPOLATION SCHEME OF ORDER COMP- 


ARABLE TO 4TH ORDER MERSON METHOD. DZETA IN TURN 
WILL CALL STARTER METHOD WHEN LAG IS SMALLER 
THAN CURRENT STEP SIZE. 


LIMENSION WK(1), X(1) 

DIMENSION WKA(1) 

DIMENSION TT(1), XX(N,1), 22(N,1) 
EXTERNAL F, FINIT, ALPHA 

INTEGER Sw 

LOGICAL BE, BH, BR, BX, BT 


DATA 
ES = 
IER 
IF ( 
Isl 
IB2 


tou 2 a 


ZERO, P5, OPS, THREE, FOUR //@.,.5,1.5,3.,4.// 
-S*EPS 


+ oN 

- 

Bl +N 
KREKKEKKKEKEKEKHEKEKKKKEKKKKKKKKKKKKKKKKEK 


CHECK FOK THE PROPER SIGN OF H 


RKEKKKKKKKKAKKKKRKEKKKKKKKKKKEKRKKKEK KKK 


7) 
-EQ.B 

N 

I 


SIGN (ABS (H) ,B-A) 


KREKKKKKEKKKEKKKEKKKKKKKEKKEKKKKKKKKKKKEKEK 


CHECK FOR 1ST CALL TO DMRODE. IF 


YES, THEN INITIALIZE NEC. ARRAYS 
RRR KKK RRR KAR KR ARKKERKKEKKA EK KKK AK 


DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 


DMR 
DMR 


DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 


DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 


250 
260 
270 
280 
296 
300 
319 
328 
330 
349 
359 
368 
379 
380 
399 
400 
410 
420 
430 
449 
450 
460 
479 
489 
490 
500 
519 
529 
539 
540 
558 
569 
570 
58 
59 
600 
610 
620 
630 
6443 
658 
664 
6735 
686 
690 
780 
718 
728 
730 
746 
758 
760 
778 
780 
790 
880 
81a 
820 
830 
840 
859 
860 
878 
880 
890 
908 
918 
920 
930 
9408 
95@ 


960 

970 

986 

990 
1020 
1019 
1020 
1030 
1040 
1050 
19€@ 
1070 
1Q0E&@ 
1090 
11@8 
1119 
1126 
1130 
1140 
1156 
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COLLECTED ALGORITHMS (cont.) 


* 


IF 
JR 
JS 
TT 
DO 


(JSTAKT.NE.®@) GO TO 20 
AY = 1 
AVE = JRAY 
(1) A 
19 J=1,N 
XX(J,1) = X#(J) 
22(J,1)=DZETA(TT (1) -X9,TT,XX,22,AA,F,FINIT,ALPHA, 
N,J,WKA(N+1) ,H,1,1Q) 


1@ CONTINUE 
20 CONTINUE 


BH = .TRUE. 
BR = .TRUE. 
BX = .TRUE. 
BT = .TRUE. 
X =A 
XS =A 
IF (ABS(H).GE.HMAX) H = SIGN(1.,H) *HMAX 
IJK9 = N+ J 
WK(IJK@) = XO(J) 
30 CONTINUE 
Cc KKK KK KK KKK KKK KEKKKHKKKEKKKKKKEK 
Cc CHECK JSTART AND EXECUTE 
Cc PROPER INITIALIZATION 
C KKK KIRA KEKE KKK KIKI KKK AKER KK KER KARE 
IF (JSTART) 40, 90, 58 
4@ JRAY = JSAVE 
5@ DO 6@ J=1,N 
IJK®@ = N+ 0d 
WK(IJK@) = XX(J,JRAY) 
6@ CONTINUE 
JSAVE = JRAY 
GO TO 98 
70 XS = X 
C KREKKKKKEKEKKEKKEKKEKKKEKKEKKKKKKKKEKKKEKKE 
Cc AFTER EACH SUCCESSFUL TIME STEP 
Cc UPDATE TT,XX,22 ARRAYS. CALL TO 
Cc DZETA PERFORMS NECESSARY INTERPO- 
Cc LATION AT LAG POINT. 
Cc KKK KKK KR KIRK RK KIKI KKK EKA KKK KEKE 
TT(JRAY+1) = X 
DO 898 J=1,N 
IJK®@ = N+dI 
WK(IJK@) = X@(J) 
XX(J,JRAY+1) = X@(J) 
HH = X - TT(JRAY) 
ZZ(J,JRAY+1) = DZETA(TT(JRAY+1) ,X@0,TT,XX,22,AA,F,FINIT, 
* ALPHA,N,J,WKA(N+1) ,HH,JRAY,IQ) 
8@ CONTINUE 
Cc KK KIRK KKK KR KK IKK RK ERK KKK KKK IK 
Cc INSERT CALL TO PRINT ROUTINE HERE 
Cc IF DESIRED. 
Cc RAK KI KIKI KKK KKK KKK AKER KKK IKKE KKK IKK 
JRAY = JRAY + 1 
IF (BR) GO TO 99 
H = HSS 
RETURN 
96 HSS = H 
Cc KOK KOK IK IK KR RIKKI KKK ERIK KER KKK RK KK KK 
Cc TEST FOR END OF PROBLEM 
Cc KKK KR KKK KK RK RK IRR RRR KKK KKK KK 
Q= xX +H -B 
BE = .TRUE. 
IF (.NOT.((H.GT.ZERO .AND. Q/H.GE.-.5) .OR. (H.LT.ZERO .AND. 
* Q/(-H).LE..5))) GO TO 118 
IF (BT) HSS = H 
H = .5* (B-X) 
IF (.NOT.BT) H = B - X 
IF (BT) GO TO 1986 
BR = .FALSE. 
160 BT = ,FALSE, 
11@ CONTINUE 
H3 = H/THREE 
Cc KAEKEKKKKEKKKEKREKKEKEKRKREKEKEKEKKKKKKEKEKKEKEEE 
Cc CALCULATE SOLN. AT X+H 
Cc KKEKKKIK KHER KKEKKEEKEKKKKKKKRKEKKKKKE KKK 
DO 270 Sw=1,5 
Cc KEEKKEKRKKEEKKKEKKKKEKKRKKKRKKKKKKKKKKEKKER 
Cc DZETA CALCULATES LAG AND SOLUTION 
Cc AT PAST POINT (NEC. FOR F ) 
C KAEKKKKKEKKKEKEKKEKKKKKKKEKRKEEKEKKEKEKKKEKKER 


DO 128 JS=1,N 


WKA(JS) = DZETA(X,X@,TT,XX,22,AA,F,FINIT,ALPHA,N,JS, 


sd WKA(N+1) ,H,JRAY,IQ) 
128 CONTINUE 
DO 13@ JS=1,N 
WK(JS) = F(X,X0,WKA,JS) 
138 CONTINUE . 
DO 239 I=1,N 
Q = H3*wK(I 


(I) 
IJk9 = N+ TI 


DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMK 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 


1160 
1170 
1186 
119@ 
1200 
12190 
1228 
1238 
1248 
1250 
1266 
1278 
1289 
1290 
1300 
13186 
1328 
1336 
1340 
1350 
1360 
1370 
1380 
1398 
1400 
1419 
1420 
1439 
1440 
1458 
1468 
1470 
1486 
1490 
1500 
1510 
1528 
1530 
1548 
1550 
1560 
15768 
1580 
1596 
1689 
1619 
1628 
1638 
1649 
1650 
1668 
1679 
1689 
1699 
1708 
1719 
1720 
1730 
1746 
1750 
1760 
1778 
1788 
1798 
1880 
181@ 
1820 
1838 
1840 
12858 
1862 
1870 
1880 
1896 
1900 
1910 
1922 
1939 
1948 
1958 
1960 
1978 
1989 
1990 
2000 
2610 
2020 
2030 
2240 
2258 
2260 
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COLLECTED ALGORITHMS (cont.) 


aan 


Aaa 


AaAaAaAN 


aan 


nn 


ANABAG 
Qzc% 


140 


15@ 


16 


17G 


180 


190 


208 


260 
270 


280 


290 


368 


IJK1 IB1 + I 

IJK2 IB2 + I 

GO TO (140, 150, 160, 170, 180), SW 
R= Q 

WK(IJK1) = Q 

GO TO 198 


R = P5*(Q+WK(IJK1) ) 
GO TO 196 


R = THREE*Q 

WK(IJK2) = R 

R = .375* (R+WK(IJK1) ) 
GO TO 198 


R = WK(IJK1) + FOUR*Q 
WK(IJK1) = R 

Kk = OP5* (R-WK(IJK2) ) 
GO TO 199 


R P5* (Q+WK(IJK1) ) 

Q ABS (R+R-OP5* (Q+WK (IJK2) ) ) 
XO(I) = WK(IJK@) + R 

IF (SW.NE.5) GO TO 230 


RKKKKEKKKKEKKEKEEKREKREREKEEKEKEKEKEKKEKKKEKE 


AUTOMATIC STEP CHANGE 
FOR KK RK TR KK RIK RRR KKK KR RK 
= ABS (X@(I)) 
= E5 
F (E.GE.1.E-3) R = E*ES 
F (HMIN.EQ.HMAX) GO TO 280 
KKK RIK IRI KK IHRE RR RRR KR RK 


TEST ADJUSTMENT OF THE STEP 
RRR KKK KKK RK KER KERR KEK KEK KKK KR 


IF (Q.LT.R .OR. (.NOT.BX)) GO TO 226 
BR = .TRUE. 

BT = .TRUE. 

BH = .FALSE. 

H = P5*H 


If (ABS(H).GT.HMIN) GO TO 280 
If (.NOT.BR) GO TO 288 
HK KKK KKK KKK KRKKERR EEE AKER 
THE STEP IS HALVED RESTORE X AND XO, 
AND GO BACK FGR REPEATED INTEGRATION 
WITH THIS NEW STEP 
KKK KKK RRR RK KKK KR KK ERK KERR RAKE 
H = SIGN(1.,H) *HMIN 
BX = .FALSE. 
IER = 1 
DO 218 J=1,N 
IJK®@ = N+ J 
XO(J) = WK(IJK@) 
CONTINUE 
X = XS 
GO TO 98 


IF (Q.GE.@.03125*R) BE = .FALSE. 


CONTINUE 
GO TO (248, 270, 258, 260, 270), SW 


X 


= X + H3 


GO TO 270 


X 


= X + PS*H3 


GO TO 2786 


X 


= X'+ P5*H 


CONTINUE 


IF 
BX 
BH 
GO 


DO 


RAKKKEKKKEAKKKKKKKAKKKEKKKKK KKK KKHKK KKK 


TEST A POSSIBLE DOUBLING OF THE STEP 
KKK KIKI RK KKK RITE ERE KK KKK 


(.NOT.(BE .AND. BH .AND. BR)) GO TO 288 
H + H 


308 I=1,N 


X8(I) = ZERO 
CONTINUE 
RETURN 


END 


FUNCTION DZETA(TA, XA, T, X, XL, TAU, F, FINIT, ALPHA, 
* JCOMP, W, HP, JRAY, NN) 


INTERPOLATION ROUTINE. CALLED BY DMRODE AND 
REQUIRES NO USER INTERFACE OTHER THAN USER 
SUPPLIED EXTERNAL FUNCTION ALPHA (SEE DMRODE). 
DZETA CALCULATES THE LAG(OR RETARDATION) VIA 


CMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 
DMR 


DZE 
DZE 
DZE 
DZE 
DZE 
DZE 
DZE 
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COLLECTED ALGORITHMS (cont.) 


AAA QAANAANDA 


QNAAMAAANN 


ann 


ZOornH 


10 


20 
30 


40 


58 
68 


70 


80 


98 


- ALPHA WITH TA,XA AS INPUT, THEN USES 2-POINT 
- HERMITE INTERPOLATION TO APPROXIMATE SOLUTION 
- AT LAG. IF STEP SIZE IS LARGER THAN LAG,HERMITE 
- INTERPOLANT CANNOT BE OBTAINED, SO DZETA CALLS 
- A TRUE ONESTEP FDE SOLVER. SINCE DMRODE CALLS 
- DZETA THE PARAMETER DESCRIPTION CAN BE FOUND 
- IN DMRODE 

DIMENSION W(1), XA(1) 

DIMENSION T(1), X(N,1), XL(N,1) 

EXTERNAL F, FINIT, ALPHA 

DATA J /1/ 

IF ((J.GE.JRAY) .AND. (J.NE.1)) J = JRAY - 1 

IF (J.LE.9) J = 1 


KKK KKK RK KK IKK IKK KKK KEKE KKK KKK KEIN 


CALCULATE LAG 
KRIKKKKRKKK KEK HEE EKER KEKEKEKEKRKAKK EK HK 
B = ALPHA(XA,TA,JCOMP) 
IF (B.EQ.TA) DZETA = XA(JCOMP) 
IF (B.EQ.TA) RETURN 
IF (((HP.LT.0.) .AND. (B.GE.TAU)) .OR. ((HP.GE.@.) .AND. 
* (B.LE.TAU))) GO TO 100 
KKKKKKKKKEKKEKRAKKEKKEKKKEKKKEKKKKKKKK KKK 
SEARCH T ARRAY IN ORDER TO FIND 
INTERVAL CONTAINING ALPHA(XA,TA,I).. 
IF NO SUCH INTERVAL IS FOUND CALL 
START OR IF ARRAY EXCEEDS 
DIMENSION IQ OF DMRODE, STOP 
KKKKKKKKKEKKKEKEKEKKEKAKEKKKKKKKKKEKKKKAKE 
DX = B - T(J) 
IF (HP.LT.@.) DX = -DX 
IF (DX) 10, 40, 30 


IF (J.EQ.1)} GO TO 48 
J=J-1 

DX = B - T(J) 

IF (HP.LT.@.) DX = -DX 
IF (DX) 16, 480, 48 
J=dg+]1 


IF (J.EQ.NN) GO TO 50 

IF (J+1.GT.JRAY) GO TO 98 
DDX = B = T(J+l) 

IF (HP.LT.®.) DDX = -DDX 
IF (DDX) 48, 20, 28 

IF (J.EQ.NN) GO TO 58 

GO TO 69 


STOP 
CONTINUE 
FOI IOI ROTO RIOT RII 


2-POINT HERMITE INTERPOLATION 
CT TCT PTC CTC CCT CCST CC ee eee ee 2 

IF (T(J+1).GE.TA) GO TO 99 
DX = T(J+1) - T(J) 
HH = B —- T(J) 
DO 78 I=1,N 

II = I+WN 

W(I) = X(I,J) 

W(II) = XL(I,J) 
CONTINUE 
AC = F(T(J) ,w,W(N+1) ,JCOMP) 
DO 8@ I=1,N 

II = I +N 

W(I) = X(I,J+1) 

W(II) = XL(I,J+1) 
CONTINUE 
AF2P = F(T(J+1) -W,W(N+1) ,-JCOMP) 
DIVDF1 = (X(JCOMP,J+1)-X(JCOMP,J) ) ,/DxX 
DIVDF3 = AC + AF2P - 2.*DIVDF1 
C3 = (DIVDF1-AC-DIVDF3) /DX 
C4 = DIVDF3,/Dx**2 
DZETA = X(JCOMP,J) + HH* (AC+HH* (C3+HH*C4) ) 
GO TO 118 


CONTINUE 

J = JRAY 

CALL START(TA, XA, T, X, XL, F, FINIT, ALPHA, N, JCOMP, W, J, 
* ANS, HP) 

DZETA = ANS 

RETURN 


1900 DZETA = FINIT(B,JCOMP) 
11@ CONTINUE 


F 


RETURN 


END 


SUBROUTINE START(TA, XA, T, X, XL, F, FINT, ALPHA, N, JCOMP, 
* W, JEND, ANS, Hl) 
-START IS A SUBROUTINE THAT CAN APPROXIMATE THE 


DZE 
DZE 


DZE 
DZE 
DZE 
DZE 
DZE 
DZE 
DZE 
DZE 
DZE 
DZE 
DZE 


STA 
STA 
STA 


828 
830 
846 
850 


928 


10 
20 
398 
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COLLECTED ALGORITHMS (cont.) 


NANAANANARANAA 


aaa 


QANAAAN 


AQaAAAAN 


ZOnHYP OZ 


18 


29 


38 


40 


5@ 


68 


78 


80 


SOLUTION AT A PAST POINT GIVEN ONLY THE SOLUTION 
AT THE MOST RECENT MESH POINT AND THE FUNCTIONS 
F AND ALPHA, AS DESCRIBED BY DMRODE. IT IS A 
RUNGE-KUTTA TYPE ALGOKITHM MODIFIED FOR RODES 
AND IS GLOBALLY 3RD ORDEK, BUT PREDICTS 4TH 
ORDER APPROX. TO BE USED IN EVALUATION OF F 

IN MERSON METHOD OF DMRODE. START, DZETA, AND 
DMRODE COMBINE TO GIVE 4TH ORDER SIMPLIFIED 
PREDICTOR-CORRECTOR TWO STEP ALGORITHM, WHERE 
START IS A TRUE ONE-STEP PREDICTOR USED ONLY 
WHEN STEP SIZE EXCEEDS THE LAG 


DIMENSION T(1), X(N,1), XL(N,1), XA(1), W(1) 


Il =N 
I2 = I1+N 
I3 = 12 + N 
14 = I3 +N 
I5 = 14 +N 
I6 = I15 + N 
Ij = I6 + N 
I6é = I7 + N 
I9 = I8 + N 
JRAY = JEND 
KKK RKKEKKEKKKKKEKKKEKKEKKKKKKEK 
RECALCULATE LAG 
KKK KKKKKKEKKKKEKKEKEKKEKKKKKKKKKKKKKEK 
B = ALPHA(XA,TA,JCOMP) 
TEST = B - T(JRAY) 
IF (H1.LT.®.) TEST = -TEST 
IF (TEST.GT.@.) GO TO 22 
JRAY = JRAY - 1 
GO TO 18 
KEKE KKKKKKAKKKEEKEKKEKEKKKKKKKKK KKK 
CONSTRUCT EULER-TYPE PREDICTOR 
CALCULATE APPROX. SOLN. AT TA+H 
SEARCH FOR LAG CORRESPONDING TO 
X(TA+H) JUST CALCULATED. 
APPROXIMATE X AT LAG VIA EULER 
KKKKKREKEKKEKEKKKKEKKEKKEKKKKKKKKKKEKEKEK 
CONTINUE 
H = Hl 
ISwiIfc = 1 
IF (JRAY.NE.JEND) H = T(JRAY+1) - T(JRAY) 
DO 3@ I=1,N 
LS = I +1 
L6 = I6 + 1 
W(L5) = X(1I,JRAY) 


W ( 
CONT 
DO 4 

Ll 

W ( 
CONT 
DO 5 

L5 

Ll 

W ( 


L6) = XL(I,JRAY) 

INUE 

@ I=1,N 

= Il +1 

L1) = F(T(JRAY) ,W(1I5+1) ,W(I6+1) ,I) 

INUE 

@ I=1,N 

= 15 + I 

= Il +1 

L5) = X(I,JRAY) + H*W(L1) 
HR IK IKKE KKK KIRKE REE 
IN EACH COMPONENT CALCULATE THE 
CORRESPONDING LAG,W(I), FOR THE 
EULER PREDICTED VALUE W(L5), AND 
EXECUTE SEARCH. 


KKKKKKEKKKEKEKKEKKKEKKKKKKKKKKKKKKKKKKKEK 


CONTINUE 
DO 99 I=1,N 
W(I) = ALPHA(W(15+1) ,T(JRAY) +H,1I) 
J = JRAY 
TEST = W(I) - T(J) 
IF (H1.LT.@.) TEST = -TEST 
IF (TEST.GE.@.) GO TO 70 
J=dI-1 
IF (J.EQ.9) GO TO 76 
GO TO 60 
CONTINUE 
L9 = 19 +1 
W(L9) = J 
IF (J.EQ.0) GO TO 9@ 


bO 8@ II=1,N 


co 


L3 = 13 + if 

L4 = 14 + II 
W(L3) = X(ITI,J) 
W(L4) = XL(II,d) 
NTINUE 


90 CONTINUE 


DO 1 
Lg 


00 I=1,N 
= 19 + I 
W(L9) 

Hl 


= 16 +I 
(J.EQ.@) W(L6) = FINT(W(I),1) 


STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
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AAA 


ANANAA 


AANAAG 


ANAAANAAN 


106 


118 


128 


13@ 
148 


158 


169 


17@ 


180 


198 


200 


219 
220 
236 


240 


IF (J.EQ.@) GO TO 160 
IF (J.NE.JEND) H = T(J+1) - T(J) 


KKK KEKE KEK KKEKKEKEE KEKE KEEKREKEKEER 


w(L6) IS THE SOLUTION AT ALPHA(W(I) ,T,1) 
RKRKKKKEEKKEKKEKEKEEKEKEEKEKEKKKKKKKKKKK 
W(L6) = X(I,Jd) + (W(I)-T(J))*F(T(J) ,W(I341) ,W(14+41) ,1) 
CONTINUE 
KRKRKKKKKKKEKEKEEKEKREKKKEKEKKEKEKKKKKKKKKK 
REPEAT ENTIRE PROCEDURE ABOVE 
USING EULER VALUE TO CALCULATE 
HEUN-TYPE 2ND ORDEK PREDICTOR 
KKK KEKEKKKEEKEKKEEKEKKEEKKEKKEKKKEK KEKE 
DO 110 I=1,N 
L2 = 12 +1 
W(L2) = F(T(JRAY) +H,W(I5+1) ,W(16+1) ,1) 


CONTINUE 
DO 120 I=1,N 
Ll = Il +1 
L2 = 12+ 1 
L3 = 13 +1 
L7 = 17+ 1 
KRRKKKKKKKEKEKEKEEKKEHKKEKKEKEKEKEKRKKKKEKE 
FOR EACH COMPONENT ESTIMATE THE 
SOLUTION AT T+H AND T+H,/2 AND STORE 
ANSWERS IN W(L3) AND W(L7) RESP. 
KEKE KKEKEKHKKEKKKKKKEKKEKEKKKKKKEKKKKE 
W(L3) = X(I,JRAY) + H*W(L1) + .5*H*(W(L2)-W(L1)) 
W(L7) = X(I,dRAY) + .5*H*W(L1) + .125*H*(W(L2)-W(L1)) 
KRARKKKEKEKKKEKEKKEKKEKEKKEKKKKRKEKEKEKKKKKKKEK 
IN STATEMENTS 1208 THRU 288 THE COR- 
RESPONDING LAGS AND THE SOLUTION AT 
THESE LAGS ARE COMPUTED TO 2ND ORDER 
BY HEUN METHOD AND STORED IN W(L4) AND 
W(L8) RESPECTIVELY 
KEKRKKKEKEEKEKKKEKEKKKEKKKKKKEKKKKKKRKKKKKES 
CONTINUE 


DO 139 I=1,N 
W(I) = ALPHA(W(1I3+1) ,T(JRAY) +H,1I) 
CONTINUE 
DO 170 I=1,N 
J = JRAY 
TEST = wW(I) - T(J) 
IF (H1.LT.@.) TEST = -TEST 
IF (TEST.GE.®@.) GO TO 168 
J=g-1 
IF (J.EQ.9) GO TO 166 
GO TO 158 


CONTINUE 
Le S23. 
W(L9) = J 
CONTINUE 
DO 29% I=1,N 
L9 = 19 +1 
J = W(L9) 
H = Hl 
IF (J.EQ.@) GO TO 250 
IF (J.NE.JEND) H = T(J4+l) - T(J) 
IF (J.EQ.JEND) GO TO 220 
DO 18@ II=1,N 
L5 = 15 + II 
L6 = 16 + II 
W(L5) = X(II,J) 
w(L6) = XL(II,J) 
CONTINUE 
DO 198 II=1,N 
Ll = Il + II 
W(L1) = F(T(J) ,W(I5+1) ,W(16+1) ,II) 
CONTINUE 
DO 200 II=1,N 
L5 = 15 + II 
L6 = 16 + II 
W(L5) = X(II,d+1) 
W(L6) = XL(II,J+1) 
CONTINUE 
DO 2106 II=1,N 
L2 = 12 + II 
W(L2) = F(T(J+1) ,W(I5+1) ,W(I6+1) , II) 
CONTINUE 
GO TO (230, 240), ISWITC 
i +1 
> tr 
I44+1 


o 
iS) 
noun 


W(L4) = X(T,0) + (W(T)-T(J))*W(L1) + .5*(W(T)-T(J)) **2* 


(W(L2)-W(11))/H 


GO TO 260 
Ll = 11+] 
L2 = 12 + J 


STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
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AANAN 


AANA 


258 


260 
270 


280 


296 


300 


w(L8) = X(I,J) + (W(I)-T(J))*W(L1) + .5*(W(I)-T(J))**2* 


* (W(L2)-wW(L1))/5 


CONTINUE 

L4 = 14 +1 

IF (ISWITC.EQ.1) W(L4) 
L8 = 18 + I 

IF (ISWITC.EQ.2) W(L8) 
GO TO 266 


FINT(W(I),1) 


FINT(W(I),1) 


GO TO (274, 290), ISWITC 
BO 28@ II=1,N 
w(II) = ALPHA(W(I7+1) ,T(JRAY)+.5*H,ITI) 


CONTINUE 
ISWITC = ISWITC + 1 
GO TO 148 
ROKK RO RIT RIK KKK KK RRR IKI RK 
USE HEUN PREDICTOR FOR 4TH ORDER 
APPROX. SOLUTION. 
2 Cee CeCe Pe eS CeCe ee ee ee 
CONTINUE 
H = Hl 


IF (JRAY.NE.JEND) H = T(JRAY+1) - T(JRAY) 
D F(T(JRAY) +H,W(13+1) ,W(14+1) ,-JCOMP) 
Cc F(T (JRAY) +.5*H,W(1I7+1) ,Ww(I18+1) ,JCOMP) 
SS = 5B - T(JRAY) 
R 
D 


tou 


L6 = 16 + I 
wW(L5) = X(1I,JRAY) 
W(L6) = XL(I,JRAY) 
CONTINUE 
I = JCOMP 
Ll = I1 + I ; 
W(L1) = F(T(JRAY) ,W(15+1) ,W(I6+1) ,JCOMP) 
KARI KERRI KR K EKER EKER AKA KKK KKK EK 
RETURN 4TH ORDER APPROXIMATION FOR 


USE IN F IN MERSON METHOD 
KKK KKK KKK KEK IKKE ERE KKEEK RAK KKK 


ANS = X(I,JRAY) + SS*(W(L1)+.5*R*(-3.*W(L1)+4.*C-D) +R*R/3.* 


* (2.*W(L1)-4.*C+2.*D) ) 
RETURN 


END 


STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 
STA 


1848 
1856 
1868 
18708 
1886 
189@ 
1908 
19190 
19296 
1930 
1948 
19598 
1960 
197@ 
19890 
1999 
2000 
2810 
2820 
2830 
2048 
2050 
2060 
2078 
2680 
2290 
21080 
2110 
2120 
2130 
2148 
2158 
21690 
2170 
2180 
2198 
2200 
2218 
2220 
2230 
2240 
2250 
2260 
2270 
2288 
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ALGORITHM 498 


Airy Functions Using Chebyshev 
Series Approximations 


P.J. PRINCE 


Teesside Polytechnic, Great Britain 


Key Words and Phrases: Airy functions, Chebyshev series approximation, Chebyshev 
coefficients, asymptotic expansion, Taylor expansion 

CR Categories: 5.12 

Language: Fortran 


DESCRIPTION 


Purpose 


This subroutine evaluates the Airy functions Ai(z) and Bi(z) and their respective 
derivatives Ai’ and Bi’, for all real values of z within computer capability, by means 
of Chebyshev series approximations. 


Method 


(a) For z < —7 the following asymptotic expansions are used (see [1, eqs. 
10.4.60, 10.4.64, 10.4.62, and 10.4.67]): 


Ai(—2) ~e™4fsf(z) — eg(z)}, Al’ (—z) ~ —24{ep(z) + sq(z)} 
Bi(—2z) ~ 24{ef(z) + sg(z)}, Bi’ (—z) ~ 2*{sp(z) — eg(z)} 


where s = sin({ + 2/4), c = cos(¢ + 7/4), ¢ = 2/3 23, and f, g, p, and qg are 
approximated by the following Chebyshev expansions: 


my, m2 ms m4 
f= >/aTA®, geri yD oreo, pz Dd aTAO, auto y' 4T* 
T=) r=0 r=0 r==(0 


where t = — (7/z)’, the 7,* are the shifted Chebyshev polynomials, and the 
a, , b, , c,, and d, are the prescribed Chebyshev coefficients. 

(b) For —7 < z < 0 the functions are given by the following Taylor expansions 
(see [1, eqs. 10.4.2 and 10.4.3 ]) : 


ef’ (z) — eag’ (2) 
V3 {er f’ (z) + e2g’ (2) } 


Ai 
Bi 


erf(z) — eg(z), Ai’ 
V3{ef(z) + eg(z)}, Bi’ 


li 
Il 
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where é; and e2 are prescribed constants, and 


my, m2 
f= >’ a,T,* (t), gz >>’ b,T,* (t) 
r=0 r=Q 


ma m4 
fiw2 DoT A(t),  g'& >’ 4,T;* (t) 
r=0 T=0 
where t = — (2/7)3. 

(c) For 0 < z < 7 the previous Taylor expansions do not allow the functions to 
be accurately calculated (unless using very high precision) at all points of the range 
because of the large fluctuation in magnitude of the functions over this range. To 
overcome this, the following Chebyshev approximations to the weighted functions 
are used: 


™m, m3 
Ai exp(1.75z) ~ 0’ a,T,*(t), Ai’ exp (1.752) ~ 0’ ¢,T;* (t) 


r=Q rmQ 


Bi exp(—1.75z) = 50’b-T,*(t), Bi’ exp(—1.752) ~ 0’ d,T,* (0) 


r= raQ) 


where t = 2/7. 
(d) For z > 7 the following asymptotic approximations are used (see [1, eqs. 
10.4.59, 10.4.63, 10.4.61, and 10.4.66 ]) : 


ms 


Ai(z) ~ 2-"4 exp (—¢) sy a,T’,* (t), Ai’ (z) ~ —2!/4 exp(—f¢) Dae c,1',* (t) 


r=0 ran) 
Bi(z) ~ 2-4 exp(¢) 30’ 0,T,*(t), Bi’ (z) ~ 2! exp(¢) Do’ d,T;* (t) 
r=0 r=0 


where t = (7/z)3/2, 

In each case the degree of approximation, m;, is such that the functions are 
determined accurate to at least nine significant. figures if the function is greater 
than unity in magnitude and to nine decimal places if not. However, in case (a) 
the final accuracy is limited by the accuracy to which the sine and cosine of ¢ + 7/4 
can be computed. In the cases (a), (b), and (d) the Chebyshev coefficients were 
computed by rearrangement of the corresponding power series expansions using 
[3, p. 52, eq. 23]. In case (c) the coefficients were computed by numerical integra- 
tion based on [8, p. 65, eq. 1], where the required Airy function values were com- 
puted in high precision using the Taylor expansions. In all four cases use is made of 
the Rice algorithm for summing the Chebyshev series (see [3, p. 57, eq. 50]). 


Program 


The subroutine is named AIRY and is composed of the four subroutines COEF1, 
COEF2, COEF8, and COEF4 corresponding, respectively, to the previous cases 
(a), (b), (c), and (d). The calling statement is 

CALL AIRY (Z, NFUNC, ISCAL, AI, BI, AID, BID) 
where the input variables Z, NFUNC, and ISCAL are defined as follows: 


Z the prescribed argument 
NFUNC §$an indicator for which of the functions are to be calculated, as follows: 


negative, for Ai’ and Bi’ only; 
NFUNC , 0, for all four functions; 
positive, for Ai and Bi only 
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ISCAL an indicator for whether or not in case (d) the following scaling is 
required: 


(Ai, Ai’) = (Ai, Ai’) exp(¢); 
(Bi, Bi’) = (Bi, Bi’) exp(—$); 
if ISCAL = 0 there is no scaling; otherwise, scaling as above. 


The output variables will contain the respective values of Ai, Bi, Ai’, and Bi’. 
After the CALL statement the input parameters arc left unchanged. 

The relevant prescribed Chebyshev coefficients are stored in arrays A, B, C, 
and D corresponding, respectively, to a,, b,, c-, and d, in the previous analysis. 
Subroutine CHEB evaluates the sum of the required Chebyshev series given the 
argument «(0 <a< 1) and the corresponding N Chebyshev coefficients 
&,&,...,@y-1Storedas A(J), J = 1,N. 


Test Results 


Tests have been carried out on an ICL 1905E computer (11S floating-point arith- 
metic). The Wronskian relationship W = AiBi’ — Ai’Bi = 1/zm has been used to 
check on the results, as have the tables in [1] and the results obtained from a high 
precision calculation based on the Taylor expansions. 

Tests have also been carried out for comparison with ACM Algorithm 301 [2], 
which gives at least eight-figure accuracy; the present algorithm is comparable in 
time for setting up large tables of the functions, and is certainly more efficient when 
only a small number of function evaluations are required outside the asymptotic 
ranges. For shorter word machines the user may truncate the given Chebyshev 
coefficients. The routine has run successfully on a Data General Corporation Nova 
840 (7S floating-point arithmetic), with at least five-figure accuracy obtained. 
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ALGORITHM 

SUBROUTINE AIRY(Z, NFUNC, ISCAL, AI, BI, AID, BID) AIR 19 
C P.J.PRINCE, MATHEMATICS DEPARTMENT, TEESSIDE POLYTECHNIC, AIR 20 
C MIDDLESBROUGH, CLEVELAND TS1 3BA, GREAT BRITAIN. AIR 30 
C JANUARY 9, 1975 . AIR 48 
C REFERENCES - : AIR 58 
C (1) - ABRAMOWITZ,M. AND STEGUN,I.A. HANDBOOK OF AIR 62 
Cc MATHEMATICAL FUNCTIONS. DOVER PUBLICATIONS INC., AIR 78 
Cc NEW YORK, 1965 PAGES 446,448-449,475-477 . AIR 80 
C (2) - FOX,L. AND PARKER,I.B. CHEBYSHEV POLYNOMIALS IN AIR 98 
Cc NUMERICAL ANALYSIS. OXFORD UNIVERSITY PRESS,1968 AIR 108 
Cc PAGES 48-58,65-68 . AIR 1186 
C (3) - BOND,GILLIAN AND PITTEWAY,M.L.V. ALGORITHM 301, AIR 120 
Cc AIRY FUNCTION(S20@). C.A.C.M. VOL. 18,NO. 5, MAY 1967 AIR 138 
C THIS SUBROUTINE EVALUATES THE AIRY FUNCTIONS AND THEIR AIR 148 
C DERIVATIVES FOR ANY REAL ARGUMENT WITHIN COMPUTER AIR 158 
C CAPABILITY, BY MEANS OF CHEBYSHEV SERIES APPROXIMATIONS. AIR 168 
C 2 - THE ARGUMENT FOR WHICH THE FUNCTIONS ARE AIR 178 
Cc TO BE BVALUATED. AIR 188 
C AI,BI - THE AIRY FUNCTIONS. AIR 198 
C AID,BID - THEIR RESPECTIVE DERIVATIVES. AIR 2860 
C NFUNC - INDICATES WHICH OF THE FUNCTIONS ARE TO BE AIR 218 
Cc CALCULATED. AIR 220 
C ISCAL - INDICATES WHETHER OR NOT SCALING IS AIR 230 
Cc REQUIRED. AIR 248 
C FOUR RANGES OF ARGUMENT Z ARE CONSIDERED - AIR 258 
C (A) @ .LE. -7.8 AIR 2680 
C (B) -7.@ .LT. Z «LE. 9.8 AIR 278 
C (Cc) 8.6 .LT. Z .LT. 7.6 ; AIR 286 
C (D) Z .GE. 7.6 AIR 298 
C THE SUBROUTINES COEF1, COEF2, COEF3 AND COEF4 WHICH ARE AIR 368 
C CALLED BY THIS SUBROUTINE CORRESPOND RESPECTIVELY 10 AIR 318 
C THESE FOUR RANGES. AIR 328 
C THE FUNCTIONS CALCULATED ARE AS FOLLOWS - AIR 3380 
C IF NFUNC IS NEGATIVE AID,BID. AIR 3486 
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IF NFUNC = @ ALL FOUR. 
IF NFUNC IS POSITIVE AI,BI. 


SCALING IS TO BE CARRIED OUT - 


WHERE ZETA = 2.0/3.6*2**1.5 

IF ISCAL = @ THEN THERE IS NO SCALING OTHERWISE SCALING 
AS ABOVE. 

IN (A) THE FINAL ACCURACY IS HEAVILY DEPENDENT ON THE 
ACCURACY TO WHICH THE SINE AND COSINE OF 

ANG = 2.0/3.0*(-2)**1.5+PI/4 CAN BE COMPUTED. 

IF ANGLM .LT. ANG .LE. ANGUP THEN SOME ACCURACY MAY BE 
LOST. A NON FATAL ERROR WARNING IS GIVEN. 

IF ANG .GT. ANGUP A NON FATAL ERROR WARNING IS GIVEN AND 
THE FOUR FUNCTIONS ARE ASSIGNED THE VALUE ZERO. 

IN (D) IF ISCAL = @ OVERFLOW IN EXP WILL OCCUR IF 

Z .GE. 2LIM. IN THIS CASE A NON FATAL ERROR WARNING IS 
GIVEN AND THE FOLLOWING VALUES ARE ASSIGNED - 

AI = AID = Q.8 

BI = BID = EXP(ZLIM). 

IF ISCAL .NE. @ OVERFLOW WILL OCCUR IF 

Z@ .GT. ZUP = ZMAX** (2.0/3.8) WHERE ZMAX IS THE MAXIMUM 
REPRESENTABLE NUMBER ON THE COMPUTER. IN THIS CASE A 
NON FATAL ERROR WARNING IS GIVEN AND THE FOUR FUNCTIONS 
ARE ASSIGNED THE VALUE ZERO. 

NOUT IS THE OUTPUT CHANNEL USED. 


APPROPRIATE DATA STATEMENTS) ARE —- 
IN COEF1 - ANGLM,ANGUP AND NOUT. 
IN COEF4 - ZLIM,ZUP AND NOUT. 
FOR I.C.L. 1985E(11S FLOATING POINT ARITHMETIC) - 
ANGLM = 25@.0, ANGUP = 1.0E190, NOUT = 2, ZLIM = 175.80, 
ZUP = 1.0E50, ZMAX = 5.6E76 
IF (2) 18, 16, 48 
1Q@ IF (Z2+7.8@) 20, 20, 3@ 
28 CALL COEF1(Z, NFUNC, AI, BI, AID, BID) 
RETURN 
3@ CALL COEF2(Z, NFUNC, AI, BI, AID, BID) 
RETURN 
40 IF (2-7.0) 58, 608, 69 
5@ CALL COEF3(Z, NFUNC, AI, BI, AID, BID) 
RETURN 
6@ CALL COEF4(Z, NFUNC, ISCAL, AI, BI, AID, BID) 
RETURN 
END 


ADAANANNANNAANANADANANANNANNANARANANA 


SUBROUTINE COEF1(Z, NFUNC, AI, BI, AID, BID) 
C THIS SUBROUTINE EVALUATES THE FOUR FUNCTIONS IN THE CASE 


C WHEN Z .LE. -7.8 USING CHEBYSHEV SERIES APPROXIMATIONS TO 


C THE CORRESPONDING ASYMPTOTIC EXPANSIONS. 
DIMENSION A(5), B(5), C(5), D(5) 
DATA A(1), A(2), A(3), A(4), A(5) /1.1282427681, 
* -0.6803534E-04,0.16687E-06,-@.128E-08,0.2E-10/ 
DATA B(1), B(2), B(3), B(4), B(5) /@.7822108673E-01, 
* ~§.6895649E-04,0.32857E-86,-0.370E-88,0.7E-10/ 


DATA C(1), C(2), C(3), C(4), C(5) /1.1285404716,0.86046925E-84, 


* -0.18161E-66,0.135E-86 ,-@.2E-10/ 

DATA D(1), D(2), D(3), D(4), D(5) /-®.10954855184, 
* 9.771335@E-04,-0.35168E-66,0.388E-08,-8.7E-10/ 
DATA PI4 /®@.78539816346/ 

DATA ANGLM, ANGUP /250.6,1.0E16/ 

DATA NOUT /2/ 


X = -2 
SX = SQRT(X) 
Y = X*SX 


ZETA = ©.66666666667*Y 
Z4 = SQRT(SX) 
ANG = ZETA + PI4 
C TEST ARGUMENT SIZE FOR SIN AND COS. 
IF (ANGLM-ANG) 16, 40, 48 
10 IF (ANGUP-ANG) 20, 28, 30 
28 WRITE (NOUT,99999) Z, ANG 


AI = @.0 
BI = @.0 
AID = @.@ 
BID = @.90 
RETURN 


3@ WRITE (NOUT,99998) Z, ANG 
40 SN = SIN(ANG) 
CN = COS (ANG) 
ZETAL = 1.0/ZETA 
X = 7.0/%X 
X = X*X*X 
C ARGUMENT SCALED TO RANGE (8,1). 
C EVALUATE THE RKELEVANT SERIES. 
IF (NFUNC.LT.@) GO TO 50 
CALL CHEB(X, 5, A, FA) 
CALL CHEB(X, 5, B, FB) 
24I = 1.06/24 


ISCAL INDICATES WHETHER OR NOT IN RANGE (BD) THE FOLLOWING 


(AI,AID) = (AI,AID)*EXP(ZETA), (BI,BID) = (B1,BID) *EXP(-ZETA) 


THE MACHINE DEPENDENT CONSTANTS (VALUES BEING ASSIGNED BY 
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FB = FB*ZETAI COE 448 
AI = 241*(SN*FA-CN*FB) COE 450 

BI = Z241* (CN*FA+SN*FB) COE 468 

IF (NFUNC.GT.@) RETURN COE 478 

5@ CALL CHEB(X, 5, C, FC) COE 486 
CALL CHEB(X, 5, D, FD) COE 498 

FD = FD*ZETAI COE 560 

AID = -Z24*(CN*FC+SN*FD) COE 518 

BID = 24* (SN*FC-CN*FD) COE 520 
RETURN COE 539 

99999 FORMAT (//38X, 3H***//5X, 28HANGLE OUTSIDE MACHINE RANGE,, COE 540 
* 38H THE FOUR FUNCTIONS HAVE BEEN ASSIGNED/5X, 11HTHE VALUE Z, COE 558 

* 4HERO.//5X, 4HZ = , E20.8, 10H ANGLE = , E28.8//38X, 3H***// COE 56@ 

* ) COE 570 
99998 FORMAT (//38X, 3H***//5X, 25HSOME ACCURACY MAY BE LOST, COE 580 
* 16H IN SIN AND COS.//5X, 4HZ2 = , E2@.8, 10H ANGLE = , COE 598 

* E20.8//38X%, 3H***//) COE 600 

END COE 618 
SUBROUTINE COEF2(Z, NFUNC, AI, BI, AID, BID) COE 180 

C THIS SUBROUTINE EVALUATES THE FOUR FUNCTIONS IN THE CASE COE 20 
C WHEN -7.@ .LT. %@ .LE. @.0 USING CHEBYSHEV SERIES COE 30 
C APPROXIMATIONS TO THE CORRESPONDING TAYLOR EXPANSIONS. COE 40 
DIMENSION A(17), B(16), C(16), D(17) COE 50 

DATA A(1), A(2), A(3), A(4), A(5), A(6), A(7), A(8), A(9), COE 690 

* A(1®@), A(11), A(12), A(13), A(14), A(15), A(16), A(17) COE 70 

* /6.11535880764,0.6542816649E-01 , 8. 26091774326 ,0.21959346500, COE 80 

* 6.12476382168,-8.43476292594,0.28357718605,-0.9751797082E-81, COE 98 

* @.2182551823E-01,-0.350454097E-62,0.42778312E-63, COE 160 

* -0.4127564E-04,6.323880E-05,-0.21123E-06,0.1165E-87, COE 119 

* -8.55E-09,0.2E-10/ COE 128 

DATA B(1), B(2), B(3), B(4), B(5), B(6), B(7), B(8), B(9), COE 130 

* B(16), B(1l), B(12), B(13), B(14), B(15), B(16) COE 148 

* /@.10888288487,-8.17511655051,9.13887871101,-8.11469998998, COE 150 

* 6.22377807641,-8.18546243714,0.8663565186E-81, COE 160 

* -0.2208647864E-O61,0.422444527E-62,-0.60131028E-63, COE 170 

* §.6653890E-04,-0.590842E-05,0.43131E-06,-8.2638E-87, COE 180 

* §.137E-08,-0.6E-160/ COE 196 

DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), COE 260 
E(B) ¢ Cli) + C(12) 5 'Cl13)7 C(14).7 (15) 5. CUS) COE 210 

* /8.7571648463E-81,-0.10158232871,08.7800551669E-61, COE 226 

* -8.8324569361E-91,0.10105322731,-8.6578603344E-O1, COE 238 

* §.2580140353E-01,-0.625962704E-02,0.111945149E-62, COE 248 

* -9.15102718E-63,0.1598986E-04,-0.136545E-85,08.9636E-87, COE 258 

* -0.572E-08,8.29E-09,-9.1E-18/ COE 268 

DATA D(1), D(2), D(3), D(4), D(5), D(6), D(7), D(8), D(9), COE 278 

* D(16), D(11), D(12), D(13), D(14), D(15), D(16), D(17) COE 280 

* /6.61603048107,0.85738069722,8.86345334421,9.80890228699, COE 298 

* -@.50565665369,-0.81829752697,0.77829538563,-8.31201242692, COE 386 

* 9.7677186198E-@1,-8.1326520264E-01,6.170185698E-82, COE 319 

* -8.17177956E-63,0.1401068E-04,-0.94532E-66,0.5374E-07, COE 328 

* -@.261E-08,6.11E-69/ COE 338 

DATA El, E2, ROOT3 /.35502805389,0.25881940379,1.7320508076/ COE 348 

X = -8.29154518950E-02*2*2*Z COE 358 

C ARGUMENT SCALED TO RANGE (@,1). COE 360 
C EVALUATE THE RELEVANT SERIES. COE 370 
IF (NFUNC.LT.@) GO TO 19 COE 380 

CALL CHEB(X, 17, A, FA) COE 396 

CALL CHEB(X, 16, B, FB) COE 406 

FA = E1*FA COE 418 

FB = E2*Z*FB COE 428 

AI = FA - FB COE 430 

BI = ROOT3* (FA+FB) COE 440 

IF (NFUNC.GT.@) RETURN COE 458 

1@ CALL CHEB(X, 16, C, FC) COE 468 
CALL CHEB(X, 17, D, FD) COE 476 

FC = E1*2*Z*FC COE 480 

FD = E2*FD COE 498 

AID = FC - FD COE 500 

BID = ROOT3* (FC+FD) COE 510 
RETURN COE 520 

END COE 530 
SUBROUTINE COEF3(Z, NFUNC, AI, BI, AID, BID) COE 18 

C THIS SUBROUTINE EVALUATES THE FOUR FUNCTIONS IN THE CASE COE 20 
C WHEN @.@ .LT. Z .LT. 7.@ USING CHEBYSHEV SEKIES COE 30 
C APPROXIMATIONS TO THE CORRESPONDING WEIGHTED FUNCTIONS. COE 46 
DIMENSION A(2@), B(25), C(22), D(24) COE 58 

DATA A(1), A(2), A(3), A(4), A(5), A(6), A(7), A(8), A(9), COE 68 

* A(1@), A(11), A(12), A(13), A(14), A(15), A(16), A(17), COE 70 

* A(18), A(19), A(20) /1.2974695794,-8. 26230907821, COE 8@ 

* -0.45786169516,0.12953331987,0.6983827954E-01, COE 90 

* -8.30065148746E-01,-8.493036334E-82,0.390425474E-B2, COE 188 

* -6.1546539E-64,-@.32193999E-03,0.3812734E-04,0.1714935E-04, CCE 118 

* -0.416096E-05,-0.50623E-06,0.26346E-06,-8.281E-08, COE 120 

* ~8.1122E-07,0.120E-08,0.31E-09,-8.7E-16/ COE 130 


DATA B(1), B(2), B(3), B(4), B(5), B(6), B(7), B(8), B(9), COE 148 


COLLECTED ALGORITHMS (cont.) 


(oneken®) 


Cc 


B(1@), B(11l), B(12), B(13), B(14), B(i5), B(16), 
B(18), B(19), B(20), B(21), B(22), B(23), B(24), 
/0.47839962387,-8.688173288G0E-61,0.2809365146768, 
~8.3988895886E-01,0.4758441683E-01,-8.812296149E-02, 
@.462845913E-02,0.76010098E-63,-0.75611274E-03, 
6.68958657E-03,-08.33621865E-83,0.14501663E-83,-8.4766359E-684, 
@.1251965E-04,-8.193012E-05,-8.19832E-06,0.29390E-686, 
-@.13436E-06,0.4231E-07,-8.967E-98,0.135E-98 ,0.7E-10, 
-@.12E-09,8.4E-10,-0.1E-10/ 
DATA C(1), C(2), C(3), C(4), 
C(18), C(l1), C(12), C(13), C(14), C(15), C(16), 
C(18), C(19), C(28), C(21), C(22) /-2.2359158747, 
-0.2638272392E-61,0.95151984332,-0.8383641182E-61, 
-@.19401383219,0.3580664778E-01,0.2269348562E-81, 
-@.671179820E-62,-8.152460473E-02,0.75474150E-83, 
®.3729934E-04,-8.5653536E-04,0.350796E-05,8.289418E-95, 
-0.47423E-06,-8.9449E-87,6.3054E-67,0.109E-G@8,-8.130E-08, 
* @.8E-10,0.4E-10,-8.1E-10/ 
DATA D(1), D(2), D(3), D(4), 
D(1@), D(11l), D(12), D(13), D(14), D(15), D(16), 
D(18), D(19), D(28), D(21), D(22), D(23), D(24) 
/@.713646629968,8.23777925892,0.28219609446,0.4912480040E-01, 
0.6741261353E-01,-8.406388553E~92,0.1544814895E-01, 
-@.449172894E-62,0.322474426E-62,-0.105361380E-82, 
@.41311371E-03,-@.8536169E-04,0.655166E-05,8.960458E-65, 
-@.641792E-05,0.280308E-05,-0.89454E-06,0.21392E-06, 
-@.2958E-@07,-6.309E-08,0.376E-08,-0.148E-08,0.39E-99, 
-0.7E-10/ 


B(17), 
B(25) 


+ * & HH 


* & e 


C(5), C(6), C(7), C(8), C(9), 


C(17), 


e+e * eH He 


D(5), D(6), D(7), D(8), D(9), 


D(17), 


ee ee eh ee OE 


X = 0.14285714286*2Z 
EX = EXP(1.75*2Z) 
EY = 1.0/EX 


AKGUMENT SCALED TO RANGE (6,1). 
EVALUATE THE RELEVANT SERIES. 
IF (NFUNC.LT.@) GO TO 10 
CALL CHEB(X, 28, A, AI) 
CALL CHEB(X, 25, 6B, BI) 
MULTIPLY BY APPROPRIATE WEIGHTING FACTORS. 


AI = AI*EY 

BI = BI*EX 

IF (NFUNC.GT.@) RETURN 
1@ CALL CHEB(X, 22, C, AID) 


CALL CHEB(X, 24, D, BID) 
MULTIPLY BY APPROPRIATE WEIGHTING FACTORS. 
AID = AID*EY 
BID = BID*EX 
RETURN 
END 


SUBROUTINE COEF4(Z, NFUNC, ISCAL, AI, BI, AID, BID) 
THIS SUBROUTINE EVALUATES THE FOUR FUNCTIONS (SCALED 
UNLESS ISCAL = §) IN THE CASE WHEN Z .GE. 7. USING 
CHEBYSHEV SEKIES APPROXIMATIONS TO THE CORRESPONDING 
ASYMPTOTIC EXPANSIONS. 
DIMENSION A(7), B(7), C(7), D(7) 
DATA A(1), A(2), A(3), A(4), A(5), A(6), A(7) 
* /0.56265126169,-0.76136219E-03,0.765252E-05,-0.14228E-06, 
* §.380E-08,-9.13E-09,0.1E-10/ 
DATA B(1l), B(2), B(3), B(4), B(5), B(6), B(7) 
* /1.1316635302,0.166141673E-02,0.1968882E-04,0.47047E-06, 
* 9.1769E-07,0.94E-69,0.6E-10/ 
DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7) 
* /0.56635357764,0.107273242E-02,-0.910634E-05,0.15998E-06, 
* -0.415E-08,0.14E-09,-0.1E-10/ 
DATA D(1), D(2), D(3), D(4), D(5), D(6), D(7) 
* /1.1238058432,-0.230925296E-62,-0.2309457E-04,-0.52171E-G6. 
* -9.1907E-07,-0.100E-08,-0.7E-16/ 
DATA ZLIM, ZUP /175.0,1.@E50/ 
DATA NOUT /2/ 
TEST FOR OVERFLOW IN 2**1.5 . 
IF (ZUP-Z) 10, 26, 20 


10 WRITE (NOUT,99999) Zz 
Al = 0.0 
BI = 0.0 
AID = 9.2 
BID = 6.0 
RETURN 
20 SZ = SQRT(Z) 
Y = 2*S2 
24 = SQRT(S2) 
IF (ISCAL) 30, 40, 30 
30 EX = 1.0 
EY = 1.8 
GO TO 70 
4G ZETA = 0.66666666667*Y 


C TEST FOR OVERFLOW IN EXP 


IF (ZLIM-ZETA) 58, 66, 68 
50 WRITE (NOUT,99998) Z, ZETA 

AI = 6.0 

AID = 0.8 


COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 


COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
COE 
CCE 
COE 
COE 


410 


498_-P 6- 


0 


COLLECTED ALGORITHMS (cont.) 


BI = EXP(ZLIM) COE 428 
BID = BI COE 430 
RETURN COE 448 

60 EX = EXP(ZETA) COE 450 
EY = 1.6/EX COE 468 
70 X = 18.520259177/Y COE 4786 

C ARGUMENT SCALED TO RANGE (@,1). COE 488 

C EVALUATE THE RELEVANT SERIES. COE 490 
IF (NFUNC.LT.@) GO TO 88 COE 508 
CALL CHEB(X, 7, A, AI) COE 518 
CALL CHEB(X, 7, B, BI) COE 528 
241 = 1.80/24 COE 536 
AI = Z4I*AI*EY COE 548 
BI = Z4I*BI*EX COE 558 
IF (NFUNC.GT.@) RETURN COE 5680 

88 CALL CHEB(X, 7, C, AID) COE 570 
CALL CHEB(X, 7, D, BID) COE 580 

AID = -Z4*AID*EY COE 590 

BID = 24*BID*EX COE 680 
RETURN COE 618 

99999 FORMAT (//38X, 3H***//5X, 18HOVERFLOW IN Z2**1.5//5X, 4HZ = , COE 628 
* E20.8//5X, 41HTHE FOUR FUNCTIONS HAVE BEEN ASSIGNED THE, COE 638 

* 12H VALUE ZERO.//38X, 3H***//) COE 646 
99998 FORMAT (//38X, 3H***//5X, 21HOVERFLOW IN EXP(ZETA)//5X, COE 6586 
* 4HZ2 = , E20.8, 9H ZETA = , E26.8//5X, 18HTHE FOLLOWING VALU, COE 66@ 

* 23HES HAVE BEEN ASSIGNED -//5X, 25HAI = AID = 9.8, BI = BID , COE 678 

* LIH= EXP(2L1M)//38X, 3H***//) COE 686 

END COE 696 
SUBROUTINE CHEB(X, N, A, F) CHE 10 

C THIS SUBROUTINE APPLIES THE RICE ALGORITHM TO THE SUM CHE 20 

C F(X) = SIGMA-PRIME (R=1 TO N) A(R)*PSTAR-SUB-(R-1) (X) CHE 38 

C WHERE THE TSTAR-SUB-R(X%) ARE THE SHIFTED CHEBYSHEV CHE 46 

C POLYNOMIALS. CHE 59 

Cc xX - THE ARGUMENT FOR WHICH THE SERIES IS TO BE CHE 69 

C EVALUATED. (8.9 .LE. X .LE. 1.0). CHE 70 

CN - THE NUMBER OF TERMS OF THE SERIES TO BE SUMMED. CHE 80 

C A(R) - THE CHEBYSHEV COEFFICIENTS FOR THE SERIES. CHE 98 

Cc F - THE COMPUTED SUM OF THE SERIES. CHE 108 
DIMENSION A(25) CHE 116 
B= 0.0 CHE 120 
D = A(N) CHE 138 
U=X+xX- 1.90 CHE 146 
Y=U+U0 CHE 150 
J=N- 1 CHE 160 
DO 10 I=3,N CHE 178 

Gap CHE 160 

B =D CHE 1986 

D = Y*B - C + A(J) CHE 200 

1@ CONTINUE CHE 220 
F = U*D - B + @.5*A(1) CHE 230 
RETURN CHE 240 
END CHE 258 


REMARK ON ALGORITHM 498 


Airy Functions Using Chebyshev Series Approximations [P.J. Price, ACM Trans. 
Math. Softw. 1, 4 (Dec. 1975), 372-379] 


M. Razaz and J.L. Schonfelder [Received 19 March 1980, accepted 11 June 1980] 


The Computer Centre, University of Birmingham, Elms Road, Birmingham, 
England. 


Algorithm 498 presents a method for approximating the Airy functions and their 
first derivatives based on Chebyshev expansions. The method employed and the 
actual Chebyshev expansions presented give adequate routines for accuracies 
limited to about 8D (absolute in the negative region and relative in the positive). 
Such limited accuracy is adequate for single precision on 32- or 36-bit machines, 
that is, working precisions of 6D to 8D, approximately. Machines currently in 
common use regularly employ floating-point precisions of 11, 15, 17, and 18D. To 
cover this accuracy range and to deal with possible double-precision implemen- 
tations, we have extended the accuracy capabilities of this basic algorithm to 30D 
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and new Chebyshev expansions have been generated to that precision [1]. This 
necessitated some modifications to the basic method of Algorithm 498. The most 
significant of such modifications was the need to introduce an additional range 
subdivision for the positive region. 

Following as closely as possible the notation of Algorithm 498, we use for 
regions (a) and (b) entirely similar expansions, with the essential differences that 
the break point is chosen at —5 rather than —7 and we absorb the constants c; 
and c2 of region (b) into the Chebyshev series. The former change is merely to 
improve the balance of the approximations for the important accuracy range 15D 
to 20D and to speed up the routines for the important argument range that 
includes the first few oscillations of the functions. 

In order to increase the precision in the positive region it becomes necessary to 
introduce an additional region (c’), analogous to region (c). For the latter region 
we employ 


Ai(z)exp(+az) = yy arT; (t), Ai’(z)exp(+ Bz) = > crT * (t) 
Bi(z)exp(—Bz) = 2 6,T* (t), Bi'(z)exp(—az) = y d,Ty (t) 


with 0 < z< 4.5, t = 2/4.5, a = 1.5, and B = 1.375. The prime means that the term 
with suffix 7 = 0 in each expansion is halved. The constants a and 8 were chosen 
to approximately minimize the variation of the function being expanded as a 
polynomial, this being required to give good relative error control for the resulting 
approximations [2]. These constants were also chosen to be exactly representable 
on any existing machine, thus aiding portability and preserving accuracy. 
For the additional region (c’) we use 
Ai(z)exp(+az) = x arT* (t), Ai’(z)exp(+az) = 0” c-TH (8) 


r=0 


Bi(z)exp(—Bz) = x b-T (0), Bi’(z)exp(—Bz) = pms d,T;*(t) 


with 4.5 <z2< 9, t = (z — 4.5)/4.5, a = 2.5, and B = 2.625. 


For region (d) we use expansions as in Algorithm 498, except that the break 
point of 9 rather than 7 is used. This allows both slightly faster convergence for 
the expansions and a more efficient and accurate calculation of t to be performed. 
The parameter ¢ can now be calculated as 


t = (9/z)?”? = 27/(z)?” = 18/¢. 


Thus we avoid the necessity of calculating a 3/2 power more than once and/or of 
carrying a further nonexact constant (7)?”. 

The modifications to the code of Algorithm 498 to employ these new expansions 
for obtaining a higher precision routine are fairly straightforward and the actual 
expansions have been published elsewhere [1]. Using these expansions the authors 
have produced routines that have been included in the S17 chapter of the NAG 
library [3]. The routines have been tested and have been shown to provide 
approximations accurate to within the errors expected for functions of this type 
for machines of precisions up to 18D, the errors being of the order of the machine 
precision except where losses are unavoidable. For instance, for large arguments 
where the errors are dominated by the imprecisions of sine, cosine, and exponeni- 
tial routines. 
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DESCRIPTION 


1. Introduction 


Scanning an array refers to selecting all the elements of the array in a particular 
order. We shall consider two scanning techniques: a raster scan and a new contour 
scan. The raster sean selects the elements of a row from left to right and rows se- 
quentially from top to bottom. The contour scan selects the elements of an array 
so that they are adjacent to or lie on a given boundary and so that the subsequent 
elements are adjacent to the previously selected points. Use of the contour scanning 
technique, rather than the raster scanning technique, accelerates the speed of 
propagation of the boundary condition effects when solving partial differential 
equations by finite-difference methods or other iterative methods. This technique 
is useful in other applications, such as pattern recognition, although the imple- 
mentation discussed here refers to iterative solutions of elliptic boundary value 
problems. 


2. Basic Concept 


Let #& be an open rectangular two-dimensional region with a boundary C containing 
an open region &; with boundaries C; and C2 as shown in Figure 1, and let the region 
& be discretized with S mesh points such that S C R. The algorithm described 
here selects all the points S; in a particular order such that S,; C Ro where Ry = 
R, U C 2. 

The selection of the points in Ro starts from a point adjacent to a boundary 
point on C,. Then all the points in Ry adjacent to Ci and on C2 are selected in a 
sequence as they occur in the clockwise direction of a path along C; and on C2. 
It is noted that line segments joining all the selected adjacent points form a polygon 
even if the boundary C, and C2 do not constitute a closed contour and intersect 
the boundary C.. Subsequently selected points in Ry are adjacent to the previously 
selected points. The procedure is repeated until the last element of S; is found. 

Special treatment is given to multiply connected boundaries. 
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Fig. 1. Mixed nonconvex boundary value problem 
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3. Implementation 


The simplest scanning procedure is the raster scan since it can be implemented 
with two DO loops. However, this procedure has two drawbacks: less favored 
boundary conditions affect the solution at the very end of the scan; and for nonrec- 
tangular boundaries the raster scan samples points outside the specified region 
where the solution is not desired. 

A scanning technique with neither drawback is the contour scan shown in Figure 
2. After the scan has been initialized by the proper selection of a starting point and 
an initial direction, it proceeds by trying to make a left turn in a two-dimensional 
array. If it encounters either a point on a Dirichlet boundary or a previously scanned 
point, it then tries to go straight ahead. If it fails, a raster scan is used to find the 
next available point within the boundaries. The raster scan terminates the pro- 
cedure when all the points in the array have been selected. 

It is seen from Figure 2 that the complexity of the path traced by the contour 
scan depends on the choice of the starting point. This starting point may be speci- 
fred by the user. However, a more efficient way of choosing a proper starting point 
and the optimum contour path is guaranteed by the subroutine CONOPT. The 
subroutine uses two criteria for selecting proper starting points: first, it tries to 
choose a point adjacent to a mesh point with the highest value of Dirichlet bound- 
ary condition; second, it tries to select a point so that the contour generated is a 
continuous curve. This latter criterion tends to produce a consistent ordering [2]. 

The subroutine HIVA locates the points with large numerical values of Dirichlet 
boundaries by means of the raster scan. The subroutine SPOINT then selects up 
to twenty choices for possible starting points. The points are chosen in such a way 
as to minimize the number of corners in the scan and so that the scan runs adja- 
cent, if possible, to the entire equipotential boundary. The subroutine CONTR 
generates different orderings from each of these points. The subroutine CONOPT 
chooses either the first continuous scan, or the scan with the fewest discontinuities. 

The initial direction in which the contour scan proceeds from a starting point is 
determined automatically in the subroutine CONTR as follows. If the Dirichlet 
boundary point is located at (I — 1, J) and the point, (J, J + 1) is an interior 
‘free’? point, the initial direction indicator, K, is set to 1, and the turn indicator, 
L, is set to 2, i.e. the scanning proceeds in the direction of increasing J. If this 
condition is not met, the previous pattern is rotated about the point (J, J). Even- 
tually, one of four possible directions will be chosen. 
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Fig. 2. Sample of boundary conditions and contour scan 


The scanning path is computed only once for each different set of Dirichlet 
boundary values and it is stored in a tabular form. The scanning then is carried 
out by a single DO loop using table look-up. One can change the direction of the 
scan by altering the table look-up. For repeated solutions of the same problem one 
may punch out the selected contour scan. 


4. Input-Output Considerations 


In order to determine a contour scanning path, data is required in the NET array 
locating Dirichlet boundaries. The optimization of the contour scan requires nu- 
merical values of these boundaries. If the boundaries are piecewise linear or are 
described by a simple function, they may be generated by the computer. Otherwise 
the user has to supply them point by point. The numerical values of the boundaries 
are introduced in the array A and the corresponding location flags are automatically 
shifted in the array NET since the dimension of the array NET is greater than 
that of the array A. The program can handle purely Neumann problems, i.e. with 
the boundary consisting of C2 only. Setting the boundary conditions in the arrays 
A and NET may be implemented in many different ways and it is felt that it does 
not belong to the described algorithm. 

The intermediate results printed by the subprogram CONOPT may be sup- 
pressed by setting the flag [PRINT to zero. 


5. Efficiency of the Algorithm 


This algorithm has been designed to be used in iterative solutions of elliptic bound- 
ary-value problems. Therefore, its efficiency can be measured by comparing the 
total machine time spent for solving a given problem when using the contour scan 
and the raser scan. We consider two stages: selecting and storing a set of points, 
S1, from the region R, U C2; and solving the problem by iteration. 

Since the implementation of the contour scan is more complex than the imple- 
mentation of the raster scan, the first stage is more economical for the raster scan, 
depending on the geometry of the region Ro. Various test problems indicate that 
the set-up time for the contour scan is 10 to 50 times longer than that for the raster 
scan. However, this set-up time is only 10 to .5 times longer than the average 
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machine time per iteration for a small problem, as in Figure 2, and for large prob- 
lems with up to 6500 points, respectively. 

The average machine time per iteration during the second stage is exactly the 
same for both scanning techniques since the number of elements in S, is the same 
in both cases. It has been found experimentally [1] that the ordering of S: generat- 
ing the contour scan causes a higher rate of convergence of the finite-difference 
methods as compared to the ordering generated by the raster scan. In all the test 
problems, this faster convergence resulted in 2 to 10 percent fewer iterations when 
using the Jacobi, Gauss-Seidel, or SOR methods. A more efficient method [1] re- 
sulted in up to 60 percent less iterations. Other scanning techniques such as the 
diagonal scan and the “‘red-black”’ scan [2] give the same rate of convergence as 
the raster scan. 

The subroutine CONTR may be used as an independent subprogram for gen- 
erating only one contour scanning path. In this case, it requires only 2 to 5 times 
more set-up time than the raster scan. 

All the test problems have been run on a CDC-6400 computer. 
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ALGORITHM 

SUBROUTINE CONOPT(M, N, MM, NN, MN, A, NET, IPRINT, NP, IJ) CON 10 
C THIS SUBPROGRAM OPTIMIZES THE CONTOUR SCAN AND IT RETURNS CON 28 
C THE OPTIMUM CONTOUR SCANNING PATH STORED IN THE ARRAY IJ. CON 38 
Cc -+-.+eINPUT VARIABLES..... CON 4G 
C M -NUMBER OF SUBDIVISIONS IN X-DIRECTION. DIMENSION OF THE CON 5@ 
Cc ARRAY A IN I DIRECTION. CON 60 
C N -AS ABOVE BUT IN Y AND J DIRECTIONS. CON 70 
C A -WORKING ARRAY WITH NUMERICAL VALUES OF DIRICHLET CON 82 
Cc BOUNDARY CONDITIONS. A(M,N). CON 98 
C MM -NUMBER OF SUBDIVISIONS IN X-DIRECTION. DIMENSION OF THE CON 189 
Cc ARRAY NET IN I DIRECTION. MM=M+2. CON 119 
C NN ~AS ABOVE BUT IN Y AND J DIRECTIONS. NN=N+2Z. CON 120 
C NET-AN INTEGER ARRAY WITH FLAGS LOCATING THE DIRICHLET CON 130 
C AND NEUMANN BOUNDARY CONDITIONS. @=VARIABLES, CON 146 
Cc 1=DIKICHLET B.C., 2=NEUMANN B.C. NET(MM,NN). THESE CON 158 
Cc FLAGS ARE SHIFTED WITH RESPECT TO THE ARRAY A SUCH CON 168 
Cc THAT THE LOCATION OF A POINT ON THE DIRICHLET BOUNDARY CON 178 
Cc A(I,J) CORRESPONDS TO NET(I+1,J+1). CON 188 
C MN -DIMENSION OF THE ARRAY IJ. IT DEPENDS ON THE LENGTH CON 196 
Cc OF THE CONTOUR PATH, NR. PREFERABLY MN=M*N. CON 200 
C IPRINT -IF IPRINT=6, THE PRINTOUT IN CONOPT IS SUPPRESSED. CON 2190 
CP FS ee areas OUTPUT VARIABLES..... CON 220 
C NP -NUMBER OF POINTS SCANNED BY THE CONTOUR PATH DETERMINED CON 236 
Cc BY THE SUBROUTINE CONTR. CON 248 
C IJ -AN INTEGER ARRAY CONTAINING COORDINATES I,J OF THE CON 258 
Cc PONT®S (I,J) SCANNED BY THE CONTOUR PATH. THEY ARE CON 260 
C DETERMINED BY CONTR. THE ARRAY IJ HAS 3 COLUMNS, THE CON 278 
c LAST ONE IS USED FOk COMPUTATIONAL PURPOSES IN CONTR, CON 288 
C AND, ON THE OUTPUT, IT CONTAINS THE CORRESPONDING FLAGS CON 298 
Cc FROM THE ARRAY NET. CON 3606 
Cc »-e+eINTERNAL VARIABLES..... CON 318 
C K -NUMBER OF STARTING POINTS DETERMINED BY THE SUBROUTINE CON 320 
Cc SPOINT. K IS USED ONLY IN THIS SUBROUTINE. CON 338 
C IJS-AN INTEGER ARRAY. IT CONTAINS 4 COLUMNS, THE FIKST TwO CON 340 
Cc OF THEM CONTAIN COORDINATES I,J OF THE STARTING POINTS CON 350 
Cc (I,J) DETERMINED BY THE SUBROUTINE SPOINT, THE THIRD CON 360 
Cc ONE CONTAINS CODED VALUES OF DIRICHLET B.C. ADJACENT CON 370 
Cc TO A POINT (I,J), AND THE LAST ONE CONTAINS THE NUMBER CON 3890 
Cc OF BREAKS IN THE CONTOUR SCAN WHICH IS INITIATED FROM CON 399 
Cc THE CORRESPONDING POINT (I,J). THE NUMBER OF ROWS IN CON 4800 
Cc IJS CAN BE CHANGED, IF NECESSARY. CON 4190 
C KK -NUMBER OF HIGH VALUE DIRICHLET BOUNDARY CONDITIONS, CON 428 
Cc DETEKMINED BY THE SUBROUTINE HIVA. KK IS USED IN SPOINT CON 4386 
C AA -AN ARRAY CONTAINING THE HIGH VALUE DIRICHLET B.C., CON 440 
Cc FOUND BY HIVA. THE LENGTH OF THE ARRAY AA CAN BE CON 450 
Cc CHANGED, IF NECESSARY. CON 460 
Cc «-e+eNOTES..... CON 478 
C THE PARAMETERS M,N,MM,NN,A,NET AND ITPRINT MUST BE SUPPLIED CON 4890 
C BY THE USER (INPUT). PARAMETERS NP AND IJ ARE RETURNED BY CON 490 
C THE SUBROUTINE CONOPT (OUTPUT). THE MAIN PROGRAM COMMUNI- CON 568 
C CATES WITH THE SUBPROGRAM CONOPT THROUGH THE PARAMETER LIST CON 5186 
C ONLY. ALL THE LABELED COMMON STCKAGE WITRIN THE SUBPROG- CON 520 
C RAM CONOPT IS FOR THE INTERNAL USE ONLY. CON 536 
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C IF THE CONDITIONS MM= M+2 AND NN= N+2 AKE NOT SATISFIED, CON 540 
C EXECUTION OF THE SUBPROGRAM IS INTERRUPTED AND A MESSAGE IS CON 5590 
C PRINTED OUT (AUTOMATIC ADJUSTMENT OF MM AND NN MIGHT CAUSE CON 56@ 
C SEVERE ERRORS IN THE MAIN PROGRAM). IF THERE IS NO DIRICH- CON 578 
C LET BOUNDARY POINT (NO Cl), THE COMPUTER AUTOMATICALLY IN- CON 580 
C SERTS SUCH A POINT IN THE REGION Rl WITHIN THE BOUNDARY C2 CON 596 
C (THIS MERELY PINS DOWN ONE SOLUTION OF THE NEUMANN PROBLEM). CON 608 
C IF THERE ARB MORE INTERIOR POINTS THAN ALLOWED BY THE IN- CON 6190 
C PUT PARAMETER MN, EXECUTION IS INTERRUPTED AND A MESSAGE CON 628 
C IS PRINTED GUT (MN MAY NOT BE ADJUSTED AUTOMATICALLY BY CON 638 
C THE COMPUTER). CON 648 
DIMENSION A(M,N), NET(MM,NN), IJ(MN,3) CON 65¢@ 
COMMON /SPT/ K, 13S(26,4) /CS/ NR /HV/ KK, AA(20) CON 660 

IF (MM.NE.M+2 .OR. NN.NE.N+2) GO TO 70 CON 670 

IP = IPRINT CON 680 

IF (IP.NE.@) WRITE (6,99999) CON 690 

C FIND PROPER STARTING POINTS FOR THE CONTOUR SCAN. CON 706¢ 
CALL SPOINT(M, N, MM, NN, A, NET, IP) CON 714 

C FIND A CONTINUOUS CONTOUR PATH, IF POSSIBLE. CON 720 
L = @ CON 730 
1@L=#=L+il CON 740 
CALL CONTR(MM, NN, MN, NET, IJ, L) CON 750 

NP = NR CON 76¢@ 

IF (IJS(L,4).EQ.6) GO TO 5¢ CON 770 

IF (L.LT.K) GO TO 10 CON 786 

C SINCE THERE IS NO CONTINUOUS PATH FIND THE PATH WITH THE CON 790 
C LARGEST NUMBER OF BREAKS. CON 860 
IG = @ CON 810 

DO 2¢ L=1,K CON 820 

IF (IJS(L,4).GT.IG) IG = IJS(L,4) CON 830 

2@ CONTINUE CON 84¢ 

C FIND THE PATH WITH THE SMALLEST NUMBER OF BREAKS. CON 85¢ 
TS = 16 CON 86¢@ 

DO 3@ L=1,K CON 879 

IF (IJS(L,4).LT.IS) IS = IJS(L,4) CON 88¢ 

3@ CONTINUE CON 89¢ 

C CHOOSE A PATH WITH THE SMALLEST NUMBER OF BREAKS BEING CON 960 
C CLOSE TO THE HIGHEST VALUE OF DIRICHLET B.C. CON 91¢ 
L=9 CON 920 

49 L=L+1 CON 930 

IF (IJS(L,4).EQ.IS) GO TO 66 CON 9406 

IF (L.LT.K) GO TO 406 CON 950 

5@ I = IJS(L,3) CON 9606 

IF (IP.NE.@) WRITE (6,99998) L, (IJS(L,J),J=1,2), AA(I) CON 97¢ 
RETURN CON 986 

66 I = IJS(L,3) CON 99¢ 

IF (IP.NE.@) WRITE (6,99997) IS, AA(I), (IJS(L,J) ,J=1,2) CON 1600 

C DETERMINE THE FINAL CONTOUR PATH. CON 1616 
CALL CONTR(MM, NN, MN, NET, IJ, L) CON 1620 
RETURN ; CON 1636 

7@ WRITE (6,99996) CON 1640 
STOP CON 165¢ 

99999 FORMAT (1H1, 1@X, 26HCONTOUR PATH OPTIMIZATION.//) CON 10660 
99998 FORMAT (/1X, 39HTHE CONTINUOUS CONTOUR SCAN HAS BEEN FO, CON 167¢ 
* QHUND AFTER, 13, 15H EVALUATION(S)./17H THE STARTING POI, CON 1680 

* 8HNT IS A(, 12, 1H,, 12, 4H) AT, E12.4, 5H B.C.//) CON 169¢ 
99997 FORMAT (/1X, 28HTHE OPTIMUM CONTOUR SCAN HAS, 14, 2H B, CON 11060 
* 17HREAK(S) (MINIMUM) /3@H AND IT STARTS FROM THE HIGHES, CON 1110 

* 17HT POSSIBLE VALUE,, E12.4/25H THE STARTING POINT IS A(, CON 1120 

* I2, 1H,, 12, 2H).//) CON 11306 
99996 FORMAT (1H1, 1X, 36HADJUST THE PARAMETERS MM AND NN SUCH, CON 114@ 
* 5H THAT/1X, SHMM = M+2/1X, 8HNN = N+2//1X, 14HSTOP FROM CONO, CON 115¢ 

* 3HPT.) CON 116¢ 

END CON 1170 
SUBROUTINE SPOINT(M, N, MM, NN, A, NET, IP) SPO 10 

C THE SUBROUTINE DETERMINES THE POSITION OF POINTS IN THE SPO 20 
C VICINITY OF THE HIGHEST AND INTERMEDIATE VALUES OF DIRICHLET SPO 30 
C BOUNDARY CONDITIONS. THE ARRAYS A AND NET SERVE AS AN INPUT. SPO 46 
C ML -AN INTEGER, ML=M+1 SPO 50 
C NL -AN INTEGER, NL=N+1 SPO 60 
C THE PARAMETERS ARE DEFINED IN CONOPT. SPO 70 
DIMENSION A(M,N), NET(MM,NN) SPO 80 
COMMON /COEF/ ML, NL /SPT/ K, 1J8(20,4) /HV/ KK, AA(2@) SPO 96 

C FIND HIGH VALUE DIRICHLET B.C. SPO 160 
CALL HIVA(M, N, MM, NN, A, NET, IP) SPO 110 

K=@ SPO 126 


DO 1¢@ L=1,KK SPO 130 
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AM = AA(L) 
C FIND POINTS SEPARATED FROM THE HIGH VALUE DIRICHLET. B.C. 
C BY ONE MESH LENGTH. THESE POINTS LIE ON THE ROWS. 
DO 3¢ I=1,M 
DO 2¢ J=1,N 
IF (NET(I+1,J+1).NE.@) GO TO 20 
IF (A(I-1,J).EQ.AM .AND. NET(I,J).NE.1) GO TO 1¢ 
IF (A(I+1,J).NE.AM .OR. NET(I+2,J+2).EQ.1) GO TO 20 
10 K=K+1 
IF (K.GT.2@) GO TO 11¢ 
IJS(K,1) = I 
IIS(K,2) = J 
TJS(K,3) = L 
2¢ CONTINUE 
3@ CONTINUE 
C FIND POINTS AS ABOVE BUT LYING ON THE COLUMNS. 
DO 6¢ J=1,N 
DO 5@ I=1,M 
IF (NET(I+1,J+1).NE.@) GO TO 5@ 
IF (A(1,J+1).EQ.AM .AND. NET(I,J+2).NE.1) GO TO 4¢ 
IF (A(I,J-1).NE.AM .OR. NET(I+2,J).EQ.1) GO TO 56 
40 K=K+1 
IF (K.GT.2@) GO TO 11¢ 
IJS(K,1) = I 
LJS(K,2) = J 
IJS(K,3) = L 
50 CONTINUE 
6@ CONTINUE 
C FIND POINTS ADJACENT TO DIRICHLET B.C., LOCATED AT CORNERS 
DO 9@ I=2,ML 
DO 86 J=2,NL 
IF (NET(I,J).NE.%) GO TO 8¢ 
IF (A(I-2,J-1).EQ.AM .AND. NET(I-1,J-1).EQ.1 .AND. 


* NET(I,J-1).EQ.1) GO TO 7¢ 

IF (A(I-1,J).EQ.AM .AND. NET(I-1,J+1).EQ.1 .AND. 
x NET(I-1,J).EQ.1) GO TO 74 

IF (A(I,J-1).EQ.AM .AND. NET(I+1,J+1).EQ.1 .AND. 
* NET(1L,J+1).EQ.1) GO TO 7@ 

IF (A(I-1,J-2) .NE.AM .OR. NET(I+1,J-1) .NE.1 .OR. 
* NET(I+1,J).NE.1) GO TO 8@ 

70 K=K+1 


IF (K.GT.2@) GO TO 11@ 
IJS(K,1) = I-1 
IJS(K,2) = J - 1 
IJS(K,3) = L 
86 CONTINUE 
96 CONTINUE 
10@ CONTINUE 
11@ IF(IP.NE.@) WRITE(6,99999) (I, (IJS(I,J), J=#1,2), I=1,K) 
RETURN 


99999 FORMAT (/1X, 39HSTARTING POINTS FOR CONTOUR OPTIMIZATIO, 1HN// 


* 5X, 2HNO, 5X, 1HI, 5X, 1HJ/(17, 216)) 
END 


SUBROUTINE HIVA(M, N, MM, NN, A, NET, IP) 
C THE SUBROUTINE DETERMINES THE HIGH VALUE DIRICHLET BOUNDA- 
C RY CONDITIONS AND IT RETURNS THEM IN THE ARRAY AA. 
C PARAMETERS ARE DEFINED IN SPOINT. 
DIMENSION A(M,N), NET(MM,NN) 
COMMON /HV/ KK, AA(20) 
C FIND THE MAXIMUM AND MINIMUM VALUES IN THE ARRAY A. 
C ARE THERE ANY POINTS OF TYPE Sl 
KK = @ 
DO 2¢ J=1,N 
Jl=J+1 
DO 10 I=1,M 
IF (NET(I+1,J1).EQ.1) KK = KK + 1 
1¢ CONTINUE 
2@ CONTINUE 
C IF KK=@¢ (NO Sl POINTS), THE SOLUTION WILL BE PINNED DOWN. 
IF (KK) 36, 30, 60 
3@ DO 5¢ J=1,N 
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C 


Jl=eJ+i1 
DO 4@ I=1,M 
IF (NET(I+1,J1).NE.@) GO TO 49 
NET(I+1,J1) = 1 
A(I,J) = 50.@ 
AA(1) = 5@.0 
KK = 1 
GO TO 12¢ 
46 CONTINUE 
5@ CONTINUE 
WRITE (6,99999) 
STOP 
60 AM = @.0 
AS = 160.0 
DO 8@ J=#1,N 
Jl=sJ+1 
DO 7¢ I=1,M 
IF (NET(I+1,J1).NE.1) GO TO 76 
IF (A(I,J).GT.AM) AM = A(I,J) 
IF (A(I,J).LT.AS) AS = A(I,J) 
76 CONTINUE 
86 CONTINUE 
KK = 1 
AA(1) = AM 
FIND INTERMEDIATE VALUES. 
DO 11@ K=1,19 
AM = AS 
DO 16% J=1,N 
Jl=J+1 
DO 99 I=1,M 
IF (NET(I+1,J1).NE.1) GO TO 9¢ 
IF (A(I,J).GT.AM .AND. A(I,J).LT.AA(K)) AM = A(I,J) 
90 CONTINUE 
166 CONTINUE 
IF (AM.EQ.AS) GO TO 12¢ 
KK = KK + l 
AA(KK) = AM 
116 CONTINUE 
126 IF (IP.NE.@) WRITE (6,99998) (1,AA(1I),I=1,KK) 
RETURN 


99999 FORMAT (/1X, 37HTHERE ARE NO FREE POINTS WITHIN A AND, 


* 26H NET. SOLUTION IMPOSSIBLE.//1X, 14HSTOP FROM HIVA, 
* 11H IN CONOPT.) 


99998 FORMAT (/1X, 25HHIGH VALUE DIRICHLET B.C./(1I7, E15.5)) 


aAAgNaaaNAaAnaAaan 


END 


SUBROUTINE CONTR(MM, NN, MN, NET, IJ, Ll) 
THE SUBROUTINE CONTR TRACES A CONTOUR SCAN WHICH COVERS 
ONLY THE INTERIOR OF THE REGION DEFINED BY BOUNDARY OF AN 
ARBITRARY SHAPE. THE SUBROUTINE REQUIRES A STARTING POINT, 
I,J,AND IT RETURNS THE CONTOUR PATH STORED IN THE ARRAY IJ 
IX -AN ARRAY USED ONLY IN THIS SUBROUTINE FOR SETTING 
A DIRECTIONAL PATTERN OF I. 
JY -AS ABOVE, BUT FOR J. 
L -AN INDICATOR OF THE PERFORMED TURN. L=1-TURN LEFT, 
L=2-GO STRAIGHT, L=3-TURN RIGHT. 
K -AN INDICATOR OF THE CHOSEN DIRECTION.K IS RELATED TO L 
OTHER PARAMETERS AS DEFINED IN CONOPT. 
DIMENSION NET(MM,NN), IJ(MN, 3) 
COMMON /COEF/ ML, NL /TEMP/ IX(5), JY(5) 
COMMON /SPT/ Kl, IJS(26,4) /CS/ NR 
SET INITIAL PARAMETERS. 
I = IJS(L1,1) + 1 
J = IJS(L1,2) +1 
L= 2 
NR = @ 
IJS(L1,4) = @ 
GO TO 3¢ 
FIND INITIAL DIRECTION OF THE SCAN, 
1@ IX(5) = IX(1) 
JY¥(5) = JY(1) 
DO 2¢ K=1,4 
I = IX(K+1) 
J = JY(Kt+1) 
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Il = IX(K) 
Jl = JY(K) 
IF (NET(I,J).NE.1 .AND. NET(I1,J1).EQ.1) GO TO 3¢ 
2@ CONTINUE 
30 NR = NR + 1 
IF (NR.GT.MN) GO TO 11¢ 
C SAVE I,J, AND NET(I,J). PROTECT NET(I,J). 


IJ(NR,1) = I- 1 
IJ(NR,2) = J- 1 
IJ(NR,3) = NET(I,J) 


NET(I,J) = 1 
C SET THE DIRECTION PATTERN. 
Ix(1) = 1-1 
JY(1) = 
IX (2) 
JY (2) 
IX (3) 
JY (3) 
IX (4) 
JY (4) J-1 
IF (NR.EQ.1) GO TO 1¢ 
C COMPUTE THE RELATIVE DIRECTION. 
K2=K+L- 2 
K = K2 + 4%(1-((3+K2)/4)) 
K2=K- 1 
IF (K2.EQ.6) GO TO 6@ 
C ROTATE THE PATTERN ACCORDING TO THE RELATIVE DIRECTION. 
DO 5@ L2=1,K2 
IX(5) = IX(1) 
JY(5) = JY¥(1) 
DO 4@ L=1,4 
IX(L) = IX(L+1) 
JY(L) = JY(L+1) 
40 CONTINUE 
5@ CONTINUE 
C CHECK ALL THE POSSIBLE MOVES. IF A MOVE IS POSSIBLE, THE 
C VALUE OF L WILL BE PRESERVED. 
6@ DO 7@ L=1,3 
I = IX(L) 
J = JY(L) 
IF (NET(I,J).NE.1) GO TO 30 
7@ CONTINUE 
C FIND AND COUNT POSSIBLE BREAKS IN THE SCAN. 
K=l 
L=2 
DO 9¢ I=2,ML 
DO 8@ J=2,NL 
IF (NET(I,J).NE.1) IJS(L1,4) = IJS(L1,4) + 1 
IF (NET(I,J).NE.1) GO TO 30 
86 CONTINUE 
9¢ CONTINUE 
C RESET THE ARRAY NET 
DO 106@ K=1,NR 
I = IJ(K,1) +1 
J = I1J(K,2) +1 
NET(I,J) = IJ(K,3) 
1¢6@ CONTINUE 
RETURN 
11@ WRITE (6,99999) 
STOP 
99999 FORMAT (/1X, 35HTHERE ARE MORE INTERIOR POINTS THAN, 6H ALLOW, 
* QHED BY MN./1X, 19HINCREASE MN TO M*N./1X, 14HSTOP FROM CONT, 
* 12HR IN CONOPT.) 
END 


a a oe 
++ 
— Re 


SUBROUTINE RASTER(MM, NN, MN, NET, IJ) 
C THE SUBROUTINE RETURNS A RASTER SCAN OF THE INTERIOR OF AN MXN 
C ARRAY. ONLY ACTIVE POINTS OF THE SCAN ARE SAVED IN IJ. 

DIMENSION NET(MM,NN), IJ(MN,3) 

COMMON /COEF/ ML, NL /CS/ NR 

WRITE (6,99999) 

NR = @ 

DO 26 I=2,ML 
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DO 1¢ J=2,NL 
IF (NET(I,J).EQ.1) GO TO 1¢ 
NR = NR + 1 
IJ(NR,1) = 
IJ(NR,2) = J- 1 
1¢ CONTINUE 
26 CONTINUE 
RETURN 
99999 FORMAT (1H1, 1@X, 11IHRASTER SCAN) 
END 


ql 
H 

I 
a 


SUBROUTINE SPIRAL(M, N, MM, NN, MN, NET, IJ) 
THE SUBROUTINE TRACES AN INWARD SPIRAL PATH WITHIN AN 
N ARRAY A. THE SCAN IS RETURNED IN IJ. 


aan0 
K4 
acd 


THE PARAMETERS ARE DEFINED IN THE SUBROUTINE CONOPT AND SPOINT. 


DIMENSION NET(MM,NN), IJ(MN,3) 
COMMON /COEF/ ML, NL /CS/ NR 
WRITE (6,99999) 
NR = 0 
C FIND THE NUMBER OF RECTANGLES WHICH WILL CONSTITUTE 
C THE SPIRAL SCAN. 
IH = MIN@(ML,NL)/2 
C BEGIN FROM THE LARGEST RECTANGLE AND SUCCESSIVELY REDUCE 
C ITS SIZE. 
DO 9@ Il=1,IH 


Is = Il 
K = 9 
C LOCATE START AND END POINTS FOR EACH SIDE OF A RECTANGLE. 
DO 86 I2=1,2 
I = tS 
IF (12.EQ.2) I = IE + 1 
IE = N - IS 
DO 76 13=1,2 
K=K+#+1 


C SCAN ONE SIDE OF A RECTANLE AND DISTRIBUTE THE SEQUENCE OF 
C POINTS TO I OR TO J. 
DO 6@ 14=IS,IE 
GO TO (10, 24, 34, 40), K 


16 J= I4 
GO TO 50 
2¢ I = 14 
GO TO 5¢ 
36 J = NL - 14 
GO TO 5¢ 
46 I = ML - 14 
50 IF (NET(I+1,J+1).EQ.1) GO TO 60 
NR = NR + 1 
IJ(NR,1) = 1 
IJ(NR,2) = J 
60 CONTINUE 
J=IE+1 
IF (12.EQ.2) J = IS 
IE = M - IS 
7@ CONTINUE 
86 CONTINUE 
9@ CONTINUE 
RETURN 
99999 FORMAT (1H1, 1@X, lLIHSPIRAL SCAN) 
END 


SUBROUTINE SORCAR(M, N, MN, A, IJ, C, IP, ER) 


C THIS SUBROUTINE OPTIMIZES THE OVERRELAXATION FACTOR USING CARRE*S 


C TECHNIQUE. 
DIMENSION A(M,N), IJ(MN,3), C(MN), GX(3) 
COMMON /LOG/ Q, QQ 
LOGICAL Q, QQ, QQQ 
WRITE (6,99999) 
C THE FIRST ITERATION USES BETA=1.¢@ 


BETA = l. 
C THE FIRST INTERVAL OF INT ITERATIONS USES BETA=1.375 
BOPT = 1.375 


C SET THE INTERVAL OF ITERATIONS 


499-P 9- 


0 


COLLECTED ALGORITHMS (cont.) 


Q 


aaa 


C IF BETA OPTIMUM HAS NOT BEEN FOUND YET, BUT ERM.LE.ER, PRINT BETA. 


INT = 12 
Q = .TRUE. 
QQQ = .FALSE. 
IN = 
SUM = 0. 
JOB = @ 

1¢ JOB = JOB + 1 
IN = IN+ 1 
QQ = IN.LT.INT 
BIG = @.@ 
S = SUM 
SUM = 0. 


CALL SOR(M, N, MN, A, IJ, C, BETA, SUM, BIG) 
QQ = (.NOT.QQ) .AND. QQQ 
Q=.FALSE. IF BETA OPTIMUM IS FOUND. 
IF (.NOT.Q) GO TO 6¢ 
QQ=.TRUE. IF JOB.GT.INT+1 AND IN=INT 
IF (QQ) GO TO 3¢ 
QQQ=.TRUE. IF JOB.GT.INT+1 
IF (QQQ) GO TO 1¢ 
IF (JOB.EQ.1) BETA = BOPT 
IF (JOB.EQ.1) IN = @ 
IF (IN.LE.INT-3) GO TO 1¢@ 
COMPUTE THREE SUCCESSIVE RATIOS OF THE DISPLACEMENT VECTOR NORMS 
AT THE END OF THE FIRST INTERVAL 
L = IN - (INT-3) 
GX(L) = SUM/S 
IF (IN.LT.INT) GO TO 10 
QQQ = .TRUE. 
Dl = GX(1) - GX(2) 
D2 = GX(2) - GX(3) 
CRITERION FOR DETERMINING THE FEASIBILITY OF AITKEN*S 
EXTRAPOLATION, THE DIFFERENCES BETWEEN THE RATIOS MUST DECREASE 
AND HAVE THE SAME SIG 
IF (ABS(D1).LE.ABS(D2) .OR. (D1/D2).LT.@.%) GO TO 26 
GAM = GX(1) - ((GX(2)-GX(1))**2/(GX(1)-2.*GX(2)+GX(3))) 
GO TO 4¢ 
2@ WRITE (6,99998) 
3@ GAM = SUM/S 
4@ IN = @ 
BL = B 
COMPUTE A NEW ESTIMATE OF BETA OPTIMUM 
BOPT = 2./(1.+SQRT (ABS (1 .—(GAM+BETA-1.)**2/ (GAM*BETA**2) ))) 
THE FOLLOWING BOPT REDUCTION PREVENTS OVERESTIMATION OF BETA 
BETA = BOPT - (2.-BOPT)/4. 
CRITERION FOR STOPPING THE PROCESS OF IMPROVING BETA. 
IF (ABS (BOPT-BL) /(2.-BOPT) .GT.@.@5) GO TO 5@ 
BETA OPTIMUM HAS BEEN FOUND 


Q = .FALSE. 
IN = INT 
BETA = BOPT 


GAM = BETA - 1. 
GR = GAM/(2.-BETA) 
WRITE (6,99997) BETA, JOB 
5@ IF (GAM.EQ.1.) GO TO 10 
ERM = BIG*GAM/(1.-GAM) 
GO TO 70 
6@ ERM = BIG*GR 
7@ IF (ABS(ERM).LE.ER) GO TO 8@ 
IF (JOB.LT.IP) GO TO 104 
8@ WRITE (6,99996) JOB, ERM 


IF (Q) WRITE (6,99995) BETA 
RETURN 


99999 FORMAT (//1X, 3@HSOLUTION BY SOR (CARRE) METHOD) 


99998 FORMAT (/5X, 45HAITKEN*S EXTRAPOLATION NOT FEASIBLE FOR BETA , 
99997 FORMAT (5X, L4HBETA OPTIMUM =, E14.7, 6H AFTER, 14, 7H ITERAT, 
99996 FORMAT (/1¢X, 22HNUMBER OF ITERATIONS =, 14/10X, 9HMAXIMUM E, 


99995 FORMAT (1@X, 22HBETA (NOT OPTIMUM) 


* 13HOPTIMIZATION. ) 
* 5HIONS.) 
* GHRROR, 8X, 1H=, E14.3, 8H PERCENT) 


=, E14.7) 
END 
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SUBROUTINE SOR(M, N, MN, A, IJ, C, BETA, SUM, BIG) 
C THIS IS THE SUCCESSIVE OVERRELAXATION ALGORITHM. 
C THE SUBROUTINE PERFORMS ONE COMPLETE SWEEP OF THE INTERIOR, AND 
C COMPUTES THE ERROR CRITERION COMPONENTS. 
DIMENSION A(M,N), IJ(MN,3), C(MN) 
COMMON /CS/ NR /LOG/ Q, QQ 
EXTERNAL AV 
LOGICAL Q, QQ 
DO 1¢ K=1,NR 
I = IJ(K,1) 
J = IJ(K,2) 
L = IJ(K,3) 
= A(I,J) 
AN = AV(M,N,MN,A,C,1,J,K,L) 
AN = AL + BETA* (AN-AL) 
A(I,J) = AN 
RES = ABS(AN-AL) 
IF (Q) SUM = SUM + RES 
IF (QQ) GO TO 1@ 
IF (RES.GT.BIG) BIG = RES 
1@ CONTINUE 
RETURN 
END 


FUNCTION AV(M, N, MN, A, C, I, J, K, L) 
DIMENSION A(M,N), C(MN) 
GO TO (14, 24, 30, 40, 50), L 
C NEUMANN B.C. ARE PARALLEL TO J-AXIS 
10 AV = (2.*A(I+1,J)+C (K)+C(K) +A(1, J+1)+A(1,J-1))/4. 
RETURN 
C NEUMANN B.C. ARE PARALLEL TO I-AXIS 
26 AV = (2.*A(1, J+1)4+C (K)+C(K)+A(I+1,J)+A(I-1,3))/4. 
RETURN 
C NEUMANN B.C. AS IN 1, BUT FOR I.GT.IN 1 
3@ AV = (2.*A(I-1 ,J)+C (K)+C (K)+A (I, J+1)+A(1,J- 1))/a, 
RETURN 
C NEUMANN B.C. AS IN 2, BUT FOR J.GT. IN 2 
4@ AV = (2.*A(1,J-1)+C(K)+C(K)+A(I41,J)+A(I-1,J))/4. 
RETURN 
C ORDINARY 5-POINT OPERATOR FOR THE INTERIOR. 
5@ AV = (A(I,J+1)+A(I+1,J)+A(I-1,J)+A(1,J-1))/4. 
RETURN 
END 


SUBROUTINE BOUND(M, N, MM, NN, A, NET) 
THE SUBROUTINE READS THE BOUNDARY CONDITIONS SPECIFIED IN THE 
DATA CARDS AND SETS THEM INTO THE ARRAYS A AND NET. THE BOUNDARY 
CONDITIONS ARE DETERMINED BY SEGMENTS P1P2 WHERE POINTS P1(I1,J1) 
AND P2(1I2,J2) COINCIDE WITH THE MESH POINTS IMPOSED ON THE REGION 
A(M,N). THE POINTS MUST SATISFY THE FOLLOWING CONDITION P1.LE.P2. 
THE VALUES AB ASSOCIATED WITH THE POINTS Pl AND P2 CAN BE AB1.LE.AB2 
OR AB1.GE.AB2. DIRICHLET B.C. ARE DISTINGUISHED FROM NEWMANN B.C. 
BY THE INDICATOR IND WHERE IND=1 FOR DIRICHLET OR IND=2 FOR NEUMANN 
B.C. EACH DATA CARD CONTAINS ONLY ONE SEGMENT P1P2 (OR A POINT). 
THE INDEX NEXT.NE.@ TERMINATES THE READING PROCESS FOR ONE PROBLEM. 
DIMENSION A(M,N), NET(MM,NN) 
COMMON /COEF/ ML, NL /TEMP/ ID(5), IY(5) 
C CLEAR THE ARRAYS. 
DO 2¢ J=1,N 
DO 1¢ I=1,M 
A(I,J) = 6.0 
NET(I+1,J+1) = @ 
16 CONTINUE 
26 CONTINUE 
C SET BORDERS IN THE ARRAYS A AND NET. 
DO 3@ I=2,ML 
NET(I,2) = 
NET(I,NL) = 
36 CONTINUE 
DO 46 J=2,NL 
NET(2,J) = 


aaQnqagaagaagaagaanna 
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NET(ML,J) = 1 
40 CONTINUE 
DO 5@ I=1,MM 
NET(I,1) = 1 
NET(I,NN) = 1 
5@ CONTINUE 
DO 6¢ J=1,NN 
NET(1,J) = 1 
NET(MM,J) = 1 
6% CONTINUE 
7@ READ (5,99999) Il, Jl, ABl, 12, J2, AB2, IND, NEXT 
IF (11.GT.12 .OR. J1.GT.J2) GO TO 15 
PLACE BOUNDARY PARALLEL TO I-AXIS INTO A. 
IF (I1.EQ.12) GO TO 9¢ 
AB = (AB2-AB1) /FLOAT (12-11) 
DO 8@ I=1I1,12 
A(I,J1) = AB1 + AB*FLOAT (I-11) 

THE FOLLOWING STATEMENT TRUNCATES ABOVE 5TH DECIMAL DIGIT. 
IF (AB.NE,@.0) A(I,J1) = AINT(A(I,J1)*1.E5)*1.E-5 
NET(I+1,J1+1) = IND 

8@ CONTINUE 
GO TO 12¢ 
PLACE BOUNDARY PARALLEL TO J-AXIS INTO A. 
90 IF (J1.EQ.J2) GO TO 11¢ 
AB = (AB2-AB1)/FLOAT(J2-J1) 
DO 10@ J=J1,J2 
A(I1,J) = AB1l + AB*FLOAT(J-J1) 
IF (AB.NE.@.@) A(I1,J) = AINT(A(I1,J)*1.E5)*1.E-5 
NET(I1+1,J+1) = IND 
106 CONTINUE 
GO TO 12¢ 
PLACE THE POINT (1I1,J1) INTO A. 
11@ A(1I1,J1) = ABL 
NET(I1+1,J1+1) = IND 
12@ IF (NEXT.EQ.@) GO TO 7¢ 
PRINT THE ARRAY NET. 
WRITE (6,99998) 
ND = 1 + (N-1)/10 
DO 130 J=1,ND 
ID(J) = J 
13@ CONTINUE 
WRITE (6,99997) (ID(J),J=1,ND) 
DO 140 I=1,M 
WRITE (6,99996) I, (NET(I+1,J),J=2,NL) 
14@ CONTINUE 
RETURN 
15@ WRITE (6,99995) 
STOP 


99999 FORMAT (2(215, F1@.4), 215) 
99998 FORMAT (1H1, 1@X, 4@HTHE FOLLOWING MATRIX REPRESENTS THE NET,, 


* 5X, 11H@=VARIABLES/56X, 26H1=DIRICHLET BOUNDARY COND./56X, 
* 24H2=NEUMANN BOUNDARY COND./) 


99997 FORMAT (1H , 35X, 5(Il, 19X)/) 
99996 FORMAT (11X, I2, 4X, 5@I2) 
99995 FORMAT (1H1, 1X, 41HINCORRECT INPUT DATA, I1.GT.I2 OR J1.GT.J, 


AaAaAAAD 


AaANARAAN 


* 2H2.) 
END 


SUBROUTINE DINE(M, N, MM, NN, MN, A, NET, IJ, C) 


THE SUBROUTINE RETURNS REFERENCE MARKS LOCATED IN THE ARRAY IJ(I,3). 


THE MARKS WILL ACCOMPANY THE SCAN AND HENCE SIMPLIFY THE LOGIC OF 
THE ITERATION PROCESS. BOUNDARY CONDITIONS IN THE ARRAY NET ARE 
IDENTIFIED BY l= DIRICHLET, 2= NEUMANN, AND @= INTERIOR OF THE 
REGION. 

DIMENSION A(M,N), NET(MM,NN), IJ(MN,3), C(MN) 

COMMON /CS/ NR 
SET MARKS OF REFERENCE, AND SAVE NEUMANN B.C. FROM A INTO C. 
1-4 = NEUMANN B.C. LOCATED AT (I-1,J),(1,J-1),(I+1,J), AND (I,J+1) 
WITH RESPECT TO THE INTERIOR OF THE REGION, RESPECTIVELY. 
5-INTERNAL (REGULAR) POINTS. NOTE THAT THE MARK CHANGE FROM @ TO 5 
IS INTERNAL TO THE PROGRAM AND IS INTRODUCED TO SIMPLIFY THE 
SELECTION OF EQUATIONS PERTINENT TO EITHER THE NEUMANN POINTS (1-4) 
OR THE REGULAR POINTS (5) /SEE FUNCTION AV/. 
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10 I35(K,3) = 5 
C(K) = 0.@ 
GO TO 3@ 
2¢ IF (NET(I+1,J).EQ.0) IJ(K,3) = 1 
IF (NET(I,J+1).EQ.6) IJ(K,3) = 2 
IF (NET(I-1,J).EQ.6) IJ(K,3) = 3 
IF (NET(I,J-1).EQ.6) IJ(K,3) = 4 
C(K) = A(I-1,J-1) 
3@ CONTINUE 
WRITE (6,99999) NR 
RETURN 
4@ WRITE (6,99998) I, J 
STOP 
99999 FORMAT (/10X, 3@HNUMBER OF SCANNED POINTS, NR= , 15) 
99998 FORMAT (/1X, 36HINCORRECT SCANNING SEQUENCE AT NET (, 12, 1H,, 
* 12, 2H).) 
END 


C THE 


DO 3@ K=1,NR 
I = 13(K,1) +1 
J = IJ(K,2) + 1 
IF (NET(I,J)-1) 106, 46, 20 


SUBROUTINE INVA(M, N, MM, NN, A, NET) 
SUBROUTINE READS A CONSTANT INITIAL VALUE, AND INTRODUCES IT 


C INTO THE ARRAY A. THE INITIAL VALUE DATUM FOLLOWS THE BOUNDARY 
C CONDITION DATA. 


10 
2¢ 


99999 
99998 


C THE 


DIMENSION A(M,N), NET(MM,NN) 
READ (5,99999) V 
DO 2¢ J=1,N 
DO 10 I=1,M 
IF (NET(I+1,J+1).NE.1) A(I,J) = V 
CONTINUE 
CONTINUE 
WRITE (6,99998) V 
RETURN 
FORMAT (F10.0) 
FORMAT (1@X, 29HCONSTANT INITIAL VALUE, Ve, F7.2) 
END 


SUBROUTINE PRES(M, N, A) 
SUBROUTINE PRINTS NUMERICAL RESULTS FROM THE ARRAY A. 


C EACH PRINTED PAGE WILL CONTAIN 16 COLUMNS OF A. 


10 


26 
30 


99999 
99998 


C THE 


DIMENSION A(M,N) 
COMMON /TEMP/ -LA(10) 
DO 30 L=1,N,1¢ 
JS =L-1 
JE=L+9 
DO 1¢@ I=1,1¢ 
LA(I) = JS + I 
CONTINUE 
WRITE (6,99999) LA 
DO 2¢ I=1,M 
WRITE (6,99998) I, (A(I,J),J=L,JE) 
CONTINUE 
CONTINUE 
RETURN 
FORMAT (1H1, 15X, 10(13, 9X)/) 
FORMAT (1H , SH A(, 12, 1H,, 3X, 16(F1@.5, 2X)) 
END 


SUBROUTINE MAP(M, N, MM, NN, A, NET) 

SUBROUTINE PRINTS THE EQUIPOTENTIAL MAP. 

DIMENSION A(M,N), NET(MM,NN), CA(1@), SP(10) 

COMMON /TEMP/ 1Z(10) 

DATA CA(1), CA(2), CA(3), CA(4), CA(5), CA(6), CA(7), CA(8), 
* CA(9), CA(1@) /1H@,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/, 


MAP 
MAP 
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* ZERO, VAL, BLANK /1HZ,1H$,1H / 
C READ EQUIPOTENTIALS TO BE PRINTED OUT. 
READ (5,99999) (SP(I),I=1,16), TOL 
C PREPARE THE MAP. 
DO 5@ J=1,N 
DO 40 I=1,M 
IF (NET(I+1,J+1).NE.1) GO TO 2@ 
IF (A(1I,J).EQ.@.@) GO TO 10 
A(I,J) = VAL 
GO TO 46 
10 A(I,J) = ZERO 
GO TO 4¢ 
20 DO 30 K=1,10 
IF (A(I,J).LT.SP(K)-TOL .OR. A(I,J).GT.SP(K)+TOL) GO TO 
* 30 
A(I,J) = CA(K) 
GO TO 4¢ 
30 CONTINUE 
A(I,J) = BLANK 
46 CONTINUE 
5@ CONTINUE 
C WRITE THE MAP. 
WRITE (6,99998) 
DO 6@ I=1,M 
WRITE (6,99997) (A(I,J),J=1,N) 
60 CONTINUE 
C WRITE THE LIMITS FOR THE EQUIPOTENTIAL STRIPS IN THE PRINTED MAP. 
WRITE (6,99996) 
DO 70 I=1,10 
IZ(I) = I-1 
7@ CONTINUE 


DO 8¢@ I=1,5 
Pl = SP(I) - TOL 
P2 = SP(I) + TOL 
P3 = SP(I+5) - TOL 


P4 = SP(I+5) + TOL 
IF (P1.LT.@.) Pl = @. 
WRITE (6,99995) IZ(I), Pl, P2, IZ(I+5), P3, P4 
80 CONTINUE 
WRITE (6,99994) 
RETURN 
C IF THE ARRAY A IS LARGER THAN 30X3@, CHANGE THE FORMAT 99997 
C TO (15X,50(Al,1X)). 
99999 FORMAT (1@F7.3, F1@.3) 
99998 FORMAT (1H1, 7X, 41HTHE FOLLOWING IS A CONTOUR MAP OF THE EQU, 
* 31HIPOTENTIALS WITHIN GIVEN LIMITS/) 
99997 FORMAT (15X, 2@(Al, 2X)/) 
99996 FORMAT (/13X, SHCONTOURS) 
99995 FORMAT (13X, Il, 1H=, E11.4, 4H TO , Ell1.4, 6H ** , Il, lHe, 
* E11.4, 4H TO , E11.4) 
99994 FORMAT (13X, I@HBOUNDARIES/13X, 22HZ= ZERO DIRICHLET B.C., 
* 8X, 4H** , 25H$= NONZERO DIRICHLET B.C.) 
END 
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Minimization of Unconstrained Multivariate 
Functions [E4] 


D. F. SHANNO and K. H. PHUA 


University of Toronto, Canada 
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CR Categories: 5.15, 5.19 
Language: Fortran 


DESCRIPTION 

Purpose 

This subroutine finds a local minimum of a nonlinear function of n variables f (x) 
where 2 = (21, %2,...,%n), 2 > 1, can be any real numbers. 

Methods 


Quasi-Newton methods are iterative methods which approximate Newton’s method 
without calculating second derivatives. The iterative sequence is defined by 


2D = 7) — gH Hg, 


where g = Vf (x), the gradient of f at 2, H® is a matrix which is designed to 
approximate the inverse Hessian, matrix of f at 2, and a is an appropriately 
chosen scalar. The sequence of matrices H is chosen to satisfy the quasi-Newton 
equation H@t)y® = ¢®, where o = xt) — ¢® and y® = g@t) — g®, In 
general, H“+» ig generated by H@+) = H® + D®, where D™ is chosen to satisfy 
the equation D®y® = ¢® — H®y®, 

The choice of a“ can be accomplished either by a linear-search or a step-length 
method. Perhaps the most complete current reference to the general theory is 
Powell [8]. Two different methods for determining a) are incorporated and are 
outlined below. The Broyden-Fletcher-Shanno (BFS) matrix update (developed 
by Broyden [1], Fletcher [3], Goldfarb [5], Greenstadt [6], and Shanno [9]) is 
used to estimate H™ in each of the algorithms. Dropping the superscripts, and 
denoting the current point by x and the subsequent point by «*, with the corre- 
sponding notation g and g*, and H and H*, the BFS formula is 


H* = (I — oy'/o'y)H (I — oy'/a'y) + o0'/o'y, 


rn I 
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' where o = x* — x, y = g* — g. This form of the update formula is that suggested 
by Fletcher [3]. 
Method 1. This method incorporates an inexact linear search for a® at each 
_ step. Features of the algorithm include the following. 

(i) The initial approximate inverse Hessian matrix proposed by Powell [7] is 
used, that is, H® = 100 |lAz ||/|| g® || Z, where Az is the vector of step bounds 
placed on all variables z,, || - || is the usual Ze-norm, and I is the n X n identity 
matrix. 

(ii) In Shanno et al. [11], it has been shown that if a is chosen to satisfy o’g* > 
o’g, then the positive definiteness of H implies that H* is also positive definite. 

' Thus a is chosen by the following algorithm. The quadratic extrapolation tech- 
- nique described in [10] is used to bracket the minimum of f(x) along the search 
_ direction s = —Hg. Davidon’s [2] cubic interpolation technique is then applied 
~ until a point is found with f* < f and o’g* > o’g. The point x* is then accepted as 
_ the next point in the sequence. 
(iii) Suppose that the step length a along the search direction s obtained by 
_ the previous step is “‘good’’; then the distance a*s* to be moved from 2* will pre- 
sumably be about the same as as. Thus, before applying the above linear-search 
technique to estimate «¢, the length of the search vector s is scaled by 
| s® || = |lo@-) ||, k = 1,..., n. Numerical results indicate that this scaling 
criterion improves our algorithm for most problems tested. 

This program is controlled by setting MODE = 1 in the parameter list of the 
subroutine MINI. For convenience, we shall denote this algorithm by MINIO1. 
According to the results presented in [12], MINIO1 appears preferable to MINIO2 
on functions where singularity of the true Hessian occurs. 

Method 2. In this method we attempt to combine the merits of linear-search 
methods and step-length methods. The main feature of this algorithm is that 
linear-search techniques are applied infrequently. Using the notation previously 
developed, the algorithm can be described by the following seven major steps. 

(1) Create the search direction. Evaluate s* = —H*g* and scale s* such that 
|| s* || is equal to || o || from the previous iteration for the first n iterations. 

(2) Perform the first extrapolation. Estimate the first move by calculating 


a = max{— 2(f — f)/s’g, 1}, 


where f is the estimated least value of f(x) provided by the user. 

(3) Evaluate the function value and its gradient. Set x* = x + as and evaluate 
f* and g*. Set of = f* — (f + us’g), where » = 0.0001. 

(4) Test for termination of the linear search. If &f < 0 and s’g* > s’g, then the 
search for a is complete. Go to step (7). 

(5) Perform Shanno and Kettler’s extrapolation technique. If of < Oand s’g* < 8’g, 
there exists & such that &@ > a and f(z + &s) < f*. In this case, apply Shanno and 
Kettler’s [10] extrapolation technique to estimate a new step length, 6, that is, 


B = as'g/(2(f — f* + as’g)). 


Set « = «* anda = 8B, and go to (3). Else go to step (6). 

(6) Perform Davidon’s cubic interpolation technique. If 5f > 0 or s’g* > 0, the 
minimum of f(x) along s has been straddled. In this case, apply Davidon’s [2 
cubic interpolation technique to estimate a new step length, +, that is, 


y = (—b +V (b — 8ac))/ (3a), 


where 
a= (2(f — f*) + a(s'g + 8'9*))/a%, 
b = (—3(f — f*) — a(2s’g + 8’9*))/o?, 


c= sg. 
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If b? — 3ac < Oorja| < 10° 
estimate y, that is, 


b |, then apply a quadratic interpolation scheme to 


y = as'g/(2(f — f* + as’g)). 


Now set a = y and go to step (8). 

(7) Test for convergence. If || g* || < ¢, then convergence is assumed. Otherwise 
update H* by the BFS formula and repcat the whole process from step (1). Note 
that this convergence criterion has been found wanting in practice for badly scaled 
problems. Because it is the criterion used by VMMO1 and MINFA, it was neces- 
sary to incorporate it in this program in order to obtain reasonable comparisons. 
A safer test can be incorporated by replacing the statement before statement 400 
with 


IF (DABS (G (1) ).-GT.EPS* (DABS (X(I)) + .001))CONV = .FALSE. 


This changes the criterion from an absolute criterion on the gradient to a relative 
criterion, or the number of positions of accuracy required in the estimates to the 
minimum. 


Remarks 


(a) We note that the change in f on an iteration according to Taylor’s theorem 
is approximately s’g when s is small, but much less than s’g in absolute value when 
the position of the minimum along a line is overestimated. The change in f relative 
to s’g cannot become arbitrarily small if (f* — f)/s’g > wu, whereeO <u <lisa 
preassigned small quantity. For more detail about the choice of this quantity, see 
Fletcher [3]. . 

(b) On each move of the linear search, a is bounded in such a way that as; < Az,, 
a = 1,2,...,m, where Az is the vector of step bounds placed on all variables 2;. 
The step bounds Az are introduced for several reasons. First, the initial estimated 
step length may be far too long, so that much is wasted in finding the desired a. 
Second, Az helps in maintaining each component of x within the domain of defini- 
tion of f(z) so that environmental difficulties such as overflow and underflow 
problems may be prevented. 

(c) In order to expedite the process of linear search, a is only estimated approxi- 
mately. In fact, the search for a is complete as soon as the conditions given in step 
(4) are fulfilled. As a consequence, the new step length obtained by applying the 
extrapolation technique as described in step (5) is restricted to bea = min{8, 10a}, 
so that the use of cubic interpolation technique may be avoided. 

(d) In real situations, it may happen that the interpolation process gets stuck 
on one side of the minimum. To overcome this difficulty, the following modification 
to step (6) is suggested: 


Ole ify < 10a 
a=<y¥y if 10a < y < (1 — 107)a 
0.8 a otherwise. 


(e) The use of this algorithm is signified by setting MODE = 2 in the parameter 
list of the subroutine MINI. For convenience, we shall denote this algorithm by 
MINIO2. According to the results presented in [12], MINIO2 is generally prefer- 
able to MINIO1, except when the Hessian has singularities, as noted previously. 
For the general user, we would recommend use of MINIO2, with a switch to MINIO1 
if convergence appears ‘‘too slow.” 


Program 


The program consists of two modified quasi-Newton minimization techniques 
(MINIO1, MINIO2) which are controlled respectively by setting MODE = 1 or 
MODE = 2 in the parameter list of the subroutine MINI. This program requires 
one user-supplied subroutine (CALCFG), which calculates the values of the ob- 
jective function and its first partial derivatives. The use of the subroutine and the 
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Table I. Comparison of Numerical Results Obtained by Four Algorithms 


(n = 


+ 
; n 


; MINIO2 


number of function and gradient cells; y = rank of each algorithm) 


MINIOL | MINFA 


; Nn seo n 


(-3.635,5.621)__ 55 
6.39,-.221) 64 
1.489 ,-2.547) _ 24 


otal rank _ 


- sone merase 
(5,0) 24 | 2 | 40 4 1 i 2 i 
(0,0) 19! 1 | 28 | 3 7 | 
(0, 20) 12 1:18 2 po ee 4 
55 6 i 1/12 2! 19 ! 4 1460—“CO 
2.5,10) | 
5,20) = 15 121 2/36) 4 § 28. 3 
otal rank 6 14 | 16 i . 14 


i 4 3 2 
i oe oe Gee 4 20 2 
| 2:80 }'4 ; 39 bt 90 3 
1a Gee ee eee a | 94 ae 
aoe ee : 

cit) ake Gee 4 } 281 2 


(250,.3,5) 


\(L00,3,12.5) 


underflow occurred 
underflow occurred 
the program exited 
underflow occurred 
the program exited 


~ 
Ww 
we 

won Hon # 


at the 73th iteration. 

at the 123lth iteration. 

with IEXIT#4, see Fletcher (4). 
at the 2nd iteration. 

with FEXIT=4, see Fletcher (4). 


meaning of the parameters are described in the comments at the beginning of sub- 
routine MINI. All communication between the main program and subroutines is 
achieved through the subroutine argument lists. An iteration is defined as the cal- 
culations required to select a new point which yields a lower function value than 


that of the previous one. 


Test Results 
These two programs (MINIO1, 


MINI02) have been tested over a wide range of 


test functions in [12]. Compared with the subroutine (VMMO01) given by Fletcher 
[3] and the subroutine (MINFA) as suggested by Powell [7], results show that 
MINIO2 is the best algorithm, while MINIO1 places second. For user comparisons, 


500-P 4- 
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we list some computational results of these two programs for the following four 
standard test functions. 
(1) Box’s function, defined by 


10 2 
f(t, m2) = Do | (eae — em) — (4 — ee) |, 
where t; ranges from .1 to 1 im steps of .1. For MINIO1 and MINIO2, the step 
bounds are set to be STP(z) = 3, 7 = 1, 2, and A = 3 for MINFA. 
(2) Rosenbrock’s function, defined by 


f (21, %2) = 100 (x — 217)? + (1 — 1)’, 
with STP (7) = 3, 7 = 1, 2, and A® = 3 for MINFA. 
(3) Wood’s function, defined by 


S (a1, Ve, X3, 24) = 100 (a2 — a2)? + (1 — a1)? + 90 (a4 — 2")? 
4 (1 _~ X3)? + 10.1[ (xe — 1 + (x4 _ 1)?] 
+ 19.8 (a — 1) (a — 1), 


with STP (z) = 10, 7 = 1,2,3,4,and A = 10 for MINFA. 
(4) Weibull’s function, defined by 


99 
f (a1, 2, ts) = DY [exp ( (ws — ts)a?/a1) — yF, 
gm] 
where the y; and ¢; are perfect data generated for the 99 points corresponding to 
y = .01 to .99 in steps of .01, for the values 2, = 50, 22 = 1.5, 23 = 25, and STP (1) 
= 800, STP(2) = 3, STP(3) = 30, and A® = 3 for MINFA. 
(5) Beale’s function, defined by 


Sf (x1, Xe) => [1.5 = “(1 = X2) - +- [2.25 — X11 (1 _ ae?) + [2.625 = al = 22°) 7}, 


with A® = 3 for MINFA and | Az;| < 3, 7 = 1, 2, for MINIO1 and MINIO2. 
(6) Powell’s function, defined by 


S (%1, V2, V3, X4) = (a +- 1022)? + 5 (a3 = eT + (Xe = 223)4 + 10 (x = ei *: 


with A® = 3 for MINFA, and | Az;| < 3, 7 = 1, 2,3, 4, for MINIO1 and MINIO2. 
(7) Cregg’s function, defined by 


S (Xi, X2, Lg, Xa) = (€7! — ae)* + 100 (a2 — 23)® + tant (as — wa) + mi® + (as — 1)’, 


with A© = 3 for MINFA, and | Az;| < 3, 7 = 1, 2, 3, 4, for MINIO1 and MINIO2. 

All tests were run in double precision on an IBM 370/165. In all cases, converg- 
ence was assumed to have occurred when | df/dx; | < 10-° for each z. Each test 
function was started from various initial estimates and their results are listed in 
Table I. The table does not differentiate function from gradient calls, because all 
programs tested calculate both each time the function subroutine is called. For a 
more complete evaluation, encompassing overhead and execution time, see [12]. 
We note here only that more careful evaluation leaves relative rankings unchanged. 
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SUBROUTINE MINI(N, X, F, G, H, M, IH, STP, EPS, FEST, MAXF, 
* MODE, ITER, IFUN, IERR, CALCFG) 
PURPOSE. THIS SUBROUTINE FINDS A MINIMUM OF THE FUNCTION F(X) 


SSeS WITHIN THE ACCURACY NORM(G(X)) .LE. EPS, WHERE G(X) IS 


THE GRADIENT OF F(X) AND EPS IS THE REQUIRED ACCURACY 
PROVIDED BY THE USER. 
THIS SUBROUTINE ADOPTS THE QUASI-NEWTON METHOD AS 
SUGGESTED BY SHANNO, D.F. AND PHUA, K.H. (1974). 
DESCRIPTION OF PARAMETERS IN THE ARGUMENT LIST 
N NUMBER OF VARIABLES 
Xx STORES THE CURRENT APPROXIMATION TO THE VARIABLES X. AN 
INITIAL APPROXIMATION SHOULD BE PROVIDED ON ENTRY, WHICH 
WILL BE REPLACED BY THE BEST ESTIMATE OBTAINED ON EXIT. 
F ON RETURN, F CONTAINS THE CORRESPONDING VALUE OF F(X). 
G ON RETURN, G IS THE CORRESPONDING GRADIENT VECTOR G(X). 
H USED TO STORE THE APPROXIMATED INVERSE HESSIAN MATRIX AS 
ROWS OF ITS UPPER TRIANGLE. 
M = N*(N+1) / 2, THE LENGTH OF THE VECTOR H. 


Ii INDICATOR CHOOSING THE INITIAL APPROXIMATION TO THE INVERSE 


HESSIAN MATRIX, 

= § THE MINI SUBROUTINE SETS H INITIALLY. 

= 1 IT IS ASSUMED THAT A GOOD ESTIMATE OF THIS MATRIX IS 
PROVIDED, FOR INSTANCE FROM PREVIOUS CALCULATIONS. 

STP THE VECTOR CONTAINS THE MAXIMUM ALLOWABLE STEP-LENGTH ON 
EACH COMPONENT OF X. THE USER MUST PROVIDE THIS VECTOR. 
PROPER CHOICE OF THE COMPONENTS STP(I) IS IMPORTANT FOR 
EFFICIENT EXECUTION. IN GENERAL, CHOOSING STP(1I) TOO LARGE 
IS PREFERABLE TO CHOOSING STP(I) TOO SMALL. THUS STP(T) 
SHOULD IDEALLY BE CHOSEN TO LIMIT SEARCH TO THE SMALLEST 


REGION ABOUT X(I) IN WHICH THE USER HAS CONFIDENCE THE TRUE 


OPTIMUM LIES. IF THE USER HAS NO FEEL FOR THE LOCATION OF 
THE TRUE OPTIMUM, STP(I) SHOULD BE CHOSEN TO BE LARGE, 
REFLECTING THE USERS VIEW THAT THE OPTIMUM MAY BE FAR FROM 
THE INITIAL ESTIMATES. 

EPS ACCURACY REQUIRED IN EACH ELEMENT OF THE GRADIENT VECTOR 
G(X). IF THE USER HAS NO FEEL FOR THE DESIRED ACCURACY OF 
HIS SOLUTION, EPS = 10**(-5) IS SUGGESTED. 

FEST A LOWER BOUND ON THE VALUE OF F PROVIDED BY THE USER. 

MAXF MAXIMUM ALLOWABLE FUNCTION EVALUATIONS, PROVIDED BY THE 
USER. MAXF ACTS SOLELY AS A DEVICE TO LIMIT EXECUTION TIME 
IN THE EVENT OF SLOW CONVERGENCE. IF THE USER HAS NO FEEL 
FOR EXECUTION TIME AS A FUNCTION OF TIME/ITERATION, 
MAXF = 266 IS SUGGESTED. 

MODE ROUTINE SELECTOR PROVIDED BY THE USER, 
= 1 MEANS THE ROUTINE MINI91 WILL BE USED. 
= 2 MEANS THE ROUTINE MINI@2 WILL BE USED. 
MODE = 2 IS SUGGESTED UNLESS CONVERGENCE IS UNACCEPTABLY 
SLOW. IN THIS CASE, MODE = 1 SHOULD BE TRIED. 

ITER NUMBER OF ITERATIONS USED. 

IFUN NUMBER OF FUNCTION EVALUATIONS USED. 

IERR ERROR MESSAGE RETURNED, 

®@ MEANS NO ERROR ENCOUNTED. 

1 MEANS IT REQUIRES MORE FUNCTION EVALUATIONS. 

2 MEANS INCREMENT IN X IS TOO SMALL, PROGRAM STUCK, 


POSSIBLY CAUSED BY 1) H SINGULAR, 2) EPS SET TOO SMALL 


(SEEK EXPERT FOR ADVICE). 

3 MEANS BOTH THE SEARCH DIRECTION AND ITS REVERSE 
DIRECTION ARE NOT DOWN-HILL, POSSIBLY CAUSED BY G 
PROGRAMMED INCORRECTLY. 


= 4 MEANS THAT FUNCTION VALUE LESS THAN FEST DETECTED. 
REMARKS 


1) THE USER MUST PROVIDE A SUBROUTINE 
SUBROUTINE CALCFG (N, XK, F, G) 
DOUBLE PRECISION X(N), G(N), F 


WHICH, GIVEN A VECTOR X IN X(1), X(2),-.-, X(N), CALCULATES THE 


FUNCTION F(X) AND THE GRADIENT G(X) AND PLACES THEM IN F AND 
G(1), G(2), ..-, G(N) RESPECTIVELY. 


2) THE VECTOR D(1@) IS USED TO HOLD THE CURRENT SEARCH DIRECTION, 


WHILE XX(1@) AND GG(18) ARE USED TO STORE THE PREVIOUS VALUES 
OF X AND G. THUS IF THE VALUE OF N IS GREATER THAN 19, THEN 
THEIR DIMENSIONS MUST BE CHANGED ACCORDINGLY. 
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Cc 


aaa 


a 


Cc 


DOUBLE PRECISION F, FEST, EPS, X(N), G(N), STP(N), H(M) 


DOUBLE PRECISION D(1@), XX(18), GG(1@), EPS2, DUM, STEP, SUM, 


* Gl, G2 
DOUBLE PRECISION STPMAX, ALPHA, AL, BL, FG, Fl, FM, GM, AA, 
* BB, CC 
DOUBLE PRECISION SS, DY, YHY, Cl, C2, DSQRT, DABS 
LOGICAL CONV 
DO INITIALIZATION OF PARAMETERS, STEP-BOUND AND UPDATE 
CALL CALCFG(N, X, F, G) 
IFUN = 1 
ITER = Q 
IERk = g 
EPS2 = EPS*EPS 
CALCULATE THE INITIAL STEP-BOUND 
DUM = @. 
STEP = Q. 
DO 1@ I=1,N 
DUM = DUM + G(I)*G(1) 
STEP = STEP + STP(I) *STP(I) 
10 CONTINUE 
IF (DUM.EQ.9.) RETURN 
SET UP THE INITIAL UPDATE 
IF (IH.EQ.®) GO TO 26 
GO TO 5¢ 
THEN 
20 DUM = 100.*DSQRT(STEP/DUM) 
IJ = 1 
DO 4@ I=1,N 
DO 30 J=I,N 
H(IJ) = @. 
IF (I1.EQ.J) H(Id) = DUM 
IJ =iI3 +1 
30 CONTINUE 
46 CONTINUE 
5@ CONTINUE 
REPEAT THE FOLLOWING 5 STEPS UNTIL EXIT FROM 4TH STEP 


RHA KKK KEE KEK KEK KK EKER KE KKK EKA KKK EE KEK KK KEKE KKK KEK KKK KEKKKKEKK 


* STEP 1. SEIT UP THE SEARCH DIRECTION AND SCALE ITS LENGTH 


* 


RARER KKK ERK KKK KK KKK KKK KKK IK KEK KEKE KEKE KK KREKKKEKEKKEKKKKKKKKKKK 


6@ SUM = Q@. 
DO 118 I=1,N 
DUM = @. 
IJ =I 
IF (I.GT.1) GO TO 79 
GO TO 99 
THEN 
70 %IIl=stI-1 
DO 8@ J=1,II 
LUM = DUM - H(Id)*G(J) 
IJ = IJ +N-J 
8@ CONTINUE 
98 CONTINUE 
DO 100 J=I,N 
DUM = DUM - H(IJ)*G(J) 
IJ = Id +1 
196 CONTINUE 
D(I) = DUM 
XX(I) = X(1) 
GG(I) = G(I) 
SUM = SUM + DUM*DUM 
110 CONTINUE 
IF ((ITER.GE.1) .AND. (ITER.LE.N)) GO TO 120 
GO TO 148 
THEN - SCALE THE LENGTH OF THE SEARCH VECTOR 
126 DUM = DSQRT(STEP/SUM) 
DO 138 I=1,N 
D(I) = D(I)*DUM 
136 CONTINUE 
149 CONTINUE 
KKK KEK EK KEKE KK KKK KKK KKK KKK KEKE KK KEK KEK KEKE KKK EKEKRHEKKKE KEK KKK KKK 
* STEP 2. TEST IF THE SEARCH DIRECTION IS DOWNHILL * 
KHKKEKKKKK EKER KICK KEK KKK KKK KEK KEKE KEKE KEK KKK EKEEKEKKK KKK KKKKK KKK 
DO 178 J=1,2 
Gl = @. 
DO 158 I=1,N 
Gl = Gl + D(I)*G(I) 
15@ CONTINUE 
IF (G1.LT.@.) GO TO 188 
DO 168 I=1,N 
D(I) = =D(I) 
168 CONTINUE 
176 CONTINUE 
180 IF (G1.GT.®.) GO TO 198 
GO TO 208 
THEN 
199 IERRK = 3 
..eee+eeERKOR EXIT - BOTH D AND -D ARE NOT DOWNHILL 
RETURN 
2060 CONTINUE 
FIND OUT THE MAXIMUM ALLOWABLE STEP LENGTH, STPMAX 
STPMAX = 1.9D+30 
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DO 219 I=1,N 
IF (DABS(D(I)).LT.1.D-38) GO TO 219 
DUM = DABS (STP(I)/D(I)) 
IF (STPMAX.GT.DUM) STPMAX = .9*DUM 
210 CONTINUE 
HRI RI RII RK IKI KIKI KIRK IER KAR KER KERIKERI AKT ERIK 


* STEP 3. PERFORM THE LINEAR SEARCH * 
KRKKKKEKKEK EEK K EEK EEK KKK KEKE KEKE EKER KKK KEKE REKRKEKKKEKKKKKKRIKK 
ALPHA = @. 
FG = Gl 
AL = 1 


IF (MODE.EQ.2) AL = 2.¥*(FEST-F)/Gl 
IF (AL.GT.1.) AL = l. 
IF (AL.GT.STPMAX) AL = @.8*STPMAX 
IF (AL.LT.@.) GO TO 220 
GG TO 236 
THEN 
228 IERR = 4 
ones eee ERROR EXIT ~- F .LT. FEST PROVIDED BY THE USER 
RETURN 
230 CONTINUE 
REPEAT THE FOLLOWING EXTRAPOLATION PROCESS 
240 Fl = F 
ALPHA = ALPHA + AL 
DO 258 I=1,N 
X(I) = XX(I) + ALPHA*D(I) 
258 CONTINUE 
CALL CALCFG(N, X, F, G) 
IFUN = IFUN + 1 
If (IFUN.GT.MAXF) GO TO 268 
GG TO 270 
THEN 
268 IERR = 1 
ween e erence ERROR EXIT - EXCEED THE MAXIMUM ALLOWED FUNCTION CALLS 


278 CONTINUE 
G2 = 8.9 
DO 286 I=1,N 
G2 = G2 + G(I) *D(1) 
280 CONTINUE 
CONV = (G2.GT.FG) .AND. (F1.GT. (F+.0001*G1) ) 
+.-EXIT THE EXTRAPOLATION LOOP, IF THE MINIMUM HAS BEEN FOUND 
IF (CONV .AND. (MODE.EQ.2)) GG TO 299 
EXIT THE EXTRAPOLATION LOOP, IF THE MINIMUM IS STRADDLED 
IF ((F.GT.F1) .OR. (G2.GT.@.)) GO TO 290 
BL = AL 
AL = @.5*G1*BL*BL/ (F1-F+BL*G1) 
IF ((MODE.EQ.2) .AND. (AL.LT.BL)) AL = 2.*(FEST-F)/G1l 
IF (AL.GT.(10.*BL)) AL = 16.*BL 
IF (AL.GT.STPMAX) AL = @.8*STPMAX 
IF (AL.LT.(1.061*BL)) AL = BL + BL 
Gl = G2 
*GO BACK TO THE EXTRAPOLATION PROCESS 
GO TO 246 
298 CONTINUE 
IF (.NOT. (CONV) .OR. (MODE.EQ.1)) GO TO 390 


GO TO 396 
THEN 
REPEAT THE FOLLOWING INTERPOLATION PROCESS 
300 BL = AL 
AA = (G1+G2+2.* (F1-F)/AL) / (AL*AL) 
BB = (G2-3.*AA*AL*AL-G1) / (AL+AL) 
CC = BB*BB - 3.*AA*G1 


DUM = DABS(AA)*1.@0D+@5 ~- DABS (BB) 
AL (.5*G1*BL*BL) / (F1-F+BL*G1) 


IF ((CC.GT.8.) .AND. (DUM.GT.@.)) AL = (-BB+DSQRT(CC))/(3.*AA) 
FM = F 

GM = G2 

IF (AL.LE.(.@01*BL)) AL = .1*BL 

IF (AL.GT.(.999*BL)) AL = .8*BL 


ALPHA = ALPHA —- BL + AL 
DO 316 I=1,N 
X(I) = XX(I) + ALPHA*D(I) 
318 CONTINUE 
CALL CALCFG(N, X, F, G) 
IFUN = IFUN + 1 
IF (IFUN.GT.MAXF) GO TO 326 
GO TO 334 
THEN 
32@ IERR = 1 
seaees »-e ERROR EXIT - EXCEED THE MAXIMUM ALLOWED FUNCTION 


RETURN 
338 CONTINUE 

G2 = @. 

DOG 348 I=1,N 

G2 = G2 + D(I)*G(I) 

340 CONTINUE 

CONV = (G2.GT.FG) .AND. (F1.GT. (F+.8801*G1) ) 
-+.-EXIT THE INTERPOLATION LOOP, IF THE MINIMUM IS FOUND 

IF (CONV) GO TO 386 
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165¢ 
1664 
167¢ 
1686 
1696 
17608 
1710 
1726 
1730 
1746 
1758 
1760 
1770 
1788 
1799 
1896 
1818 
1820 
1830 
1849 
185@ 
1868 
1870 
1880 
1896 
1980 
1910 
1920 
1938 
1940 
1958 
1966 
1976 
1988 
19990 
2000 
2019 
2020 
2038 
2040 
2858 
2060 
2870 
2086 
2890 
2160 
2118 
2120 
2130 
21406 
2150 
2160 
2176 
2180 
2196 
2200 
2210 
2220 
2230 
2240 
2256 
2268 
2270 
2289 
2290 
2302 
2318 
23208 
2330 
2348 
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2448 
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2466 
2478 
24860 
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-.-EXIT THE INTERPOLATION LOOP, IF STEP-SIZE IS TOO SMALL 
IF ((G2.GT.FG) .AND. (BL.LE.EPS2)) GO TO 389 
SS = 6. 
DO 358 I=1,N 
SS = SS + DABS(G(I)*D(I)) 
358 CONTINUE 
SS = SS/(100000.*FLOAT(N) ) 
+» eEXIT THE INTERPOLATION LOOP, IF TWO POINTS ARE CLOSED 
IF ((G2.LT.SS) .AND. (G2.GT.FG)) GO TO 389 
IF ((G2.LT.@.) .AND. (F1.GT.F)) GO TO 368 


GO TO 370 
TREN —- ADVANCE TO THE LOWER POINT 
366 Gl = G2 

G2 = GM 

Fl =F 

Fo= FM 

AL = BL - AL 


ALPHA = ALPHA + AL 
378 CONTINUE 
*GO BACK TO THE INTERPOLATION PROCESS 
GO TO 308 
38@ CONTINUE 
398 CONTINUE 
HRI KR RII KIRK RII RIOR IR IK IK RR RII IIR RR ITI RIK KIKI AE IR RIK IOK 


* STEP 4. TEST FOR CONVERGENCE “i 
FH KK IR RIKKI IR IKK IKKE I KK IKK RRR ER KR EKRRIKK RK RIKA KK RRIK 


CONV = .TRUE. 


STEP = Q@. 

DO 4048 I=1,N 
D(I) = X(I) - XX(I) 
STEP = STEP + D(I)*D(I) 


IF ((G(1I)*G(I)).GT.EPS2) CONV = .FALSE. 
408 CONTINUE 
++ee+NORMAL EXIT 
IF (CONV) RETURN 
IF (STEP.LE.(EPS2*EPS2)) GO TO 419 
GO TO 428 
THEN 
416 IERR = 2 
seeeeeee ERROR EXIT - THE STEP SIZE IS TOO SMALL 
RETURN 
42@ CONTINUE 
BRR IRR IRI IK RII KEIR RIK RR RIK IK IKK IIIT RIKI KIRKE ARK 


* STEP 5. UPDATE THE APPROXIMAVED INVERSE HESSIAN MATRIX * 
KKK KEKE EK IKK KEKE KEKE KK KEKE EK RK RK KEK KEKE KEK KERR KE EKEEEK KEK KKK 
DY = @. 
YHY = Q. 


DOG 438 I=1,N 
GG(I) = G(I) - GG(I) 
DY = DY + D(I)*GG(TI) 
430 CONTINUE 
DO 48@ I=1,N 
DUM = @. 
IJ =I 
IF (1.GT.1) GO TO 449 
GO TO 460 
THEN 
440 II=Tt-1 
DO 458 J=1,I1I 
DUM = DUM + H(IJ) *GG(J) 
IJ =IJ+N-J 
458 CONTINUE 
468 CONTINUE 
DO 478 J=I1,N 
DUM = DUM + H(IJd)*GG(J) 
IJ = IJ +1 
47@ CONTINUE 
YHY = YHY + DUM*GG(I) 
XX(I) = DUM 
480 CONTINUE 
Cl = 1. + YHY/DY 
DO 498 I=1,N 
GG(I) = Cl*D(I) - XX(I) 
490 CONTINUE 


DO 5198 I=1,N 
Cl = D(I)/DY 
C2 = XX(1I)/DY 
DO 50@ J=1I,N 
H(IJ) = H(IJ) + C1l*GG(J) - C2*D(J) 
IJ = IJ +1 
588 CONTINUE 
518 CONTINUE 
ITEK = ITER + 1 
*STEP 5 NOW COMPLETE - GO BACK TO STEP 1 
GO TO 60 
*END OF REPEAT BLOCK 
CONTINUE 
END 
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3250 
3260 
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REMARK ON ALGORITHM 500 


Minimization of Unconstrained Multivariate Functions [E4] 

[D.F. Shanno and K.H. Phua, ACM Trans. Math. Software 2, 1 (March 1976), 
87-94] 

Charles Dunham [Recd June 7, 1976] 

Computer Science Department, University of Western Ontario, London, Ont., 
Canada. 


The arrays STP and H used as arguments to this algorithm must be declared 
double precision, as declared in the body (but not the published heading) of the 
subroutine MINI. 
MINI was used to determine a best 11.5 approximation by the approximating 
function 
F(A, ©) = a, + aoe + ag exp (a,x) 


on {0,1/10,..., 9/10, 1} to the function f (x) = x + exp (x) + exp (2x)/100. This is 
a minimization problem with four parameters, a1 , dz , a3 , @4. When MINI was run 
initially with arguments STP single precision of dimension 4 and H single precision 
of dimension 10 on a CDC Cyber 73, the program hung with an error mode 2 (in- 
finite operand). With the above change (to double precision) the program pro- 
duced the approximation obtained independently by several other methods. 
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DESCRIPTION 

1. Purpose 

This subroutine finds a local minimizer of a nonlinear function of n variables f(x) 
where x = (X1,..., Xn), m 2 1 can be any real numbers. This algorithm is meant 


to supersede the algorithm documented in [11]. 


2. Methods 


The subroutine incorporates two nonlinear optimization methods, a conjugate 
gradient algorithm and a variable metric algorithm, with the choice of method 
left to the user. 

The conjugate gradient algorithm is the Beale restarted memoryless variable 
metric algorithm documented in Shanno [7]. This method requires approximately 
7n double-precision words of working storage to be provided by the user. The 
variable metric method is the BFGS algorithm with initial scaling documented in 
Shanno and Phua [10], and required approximately n?/2 + 11n/2 double-precision 
words of working storage. 

Whichever method is chosen, the same linear search technique is used for both 
methods, with two differences. The basic linear search uses Davidon’s cubic 
interpolation to find a step length a, which satisfies 


COLLECTED ALGORITHMS (cont.) 500-P11- 0 
f(x + ad) < f(x) + ad’g(x) 0.0001, (1) 


where d is the chosen search direction, g(x) = V/f(x), the gradient of f at x, and 
d’g(x), the directional derivative of f(x) at x along d, is always a negative number. 
In addition, a must satisfy 


| d’g(x + ad)/d’g(x) |< 0.9. (2) 


The convergence of the BFGS variable metric algorithm under the conditions 
(1) and (2) has been studied by Powell [6], while the convergence of the conjugate 
gradient method has been studied by Shanno [8]. 

The major difference between the two methods insofar as the linear search is 
concerned is that if the first trial a satisfies (1) and (2), it is accepted if a variable 
metric method is used, but at least two trial a’s are required before accepting an 
a satisfying (1) and (2) for the conjugate gradient method. Reasons for requiring 
this are detailed in Shanno [9]. 

The second difference between the two methods is that for a variable metric 
method, a = 1 is always the initial a tried, while for the conjugate gradient 
method, a = 1 is tried only for restart iterations, whereas for nonrestart iterations 
the initial a at step k + 1, denoted by az41, is chosen to be a4: = ap A 28p/d' pr iZe+1, 
where d; and g; and d+: and gz+1 are the search vectors and gradients at the kth 
and k + Ist points, respectively. 

The linear search contains safeguards to ensure that the search procedure 
cannot become stuck or attempt to move past a local maximum to a more distant 
local minimum. 

Convergence is determined to have occurred when || g || < € max(1, || x ||), where 
||-|| is the Euclidean norm and ¢ is user supplied. 


3. Test Results 


Table I contains test results for a variety of test problems for both the BFGS and 
conjugate gradient method. The test functions are Wood’s function for the listed 
initial estimates, the extended Rosenbrock function documented in [7], Brodlie’s 
[1] variable-dimensioned Watson function, Oren’s [5] power function, Powell’s 
four-dimensioned function [6], Fletcher and Powell’s trigonometric functions with 
initial estimates as in [2], and for various dimensions, the Mancino function with 
initial estimates as documented in [7], Moré, Garbow, and Hillstrom’s [4] bound- 
ary-value problem, and Toint’s variation on Broyden’s function [12]. The Wood 
and Powell functions are documented in [3]. 

In the table, ITER represents the number of search directions calculated, while 
IFUN represents the number of function and gradient evaluations that were 
performed. In all cases, « = 10~° was used, except for the boundary value problem, 
where € = 107%. 

With the exception of the power function, on which the BFGS does not perform 
well for reasons documented in [10], it is clear from Table I that the variable 
metric method is quite a bit more efficient in terms of function and gradient calls, 
primarily due to the fact that the first trial a can be accepted, while at least two 
trial a’s per iteration must be tried by the conjugate gradient algorithm. 

In terms of execution time, however, the issue is not so clear-cut. On a DEC-10 
computer, the Broyden-Toint function with n = 30 took 6.49 CPU seconds for 
the BFGS, while the conjugate gradient method took 5.32 due to the overhead of 
updating the approximate Hessian at each step. However, for the 30-variable 
Mancino function, the BFGS took 28.12 CPU seconds, while the conjugate 
gradient method took 72.31. As one would expect, evaluations of the Mancino 
function are quite expensive, while the Broyden-Toint function evaluations are 
quite inexpensive. 

Thus for large problems where space limitations do not preclude using the 
BFGS algorithm, users are urged to experiment to determine the most efficient 
algorithm for a particular problem. For small problems, we recommend the BFGS 
method, while for very large problems, memory considerations generally mandate 
using the conjugate gradient algorithm. 
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Table I 


BFGS Conjugate Gradient 
ITER IFUN ITER IFUN 
WOOD (n = 4) 
—3, —1, -—3, —1 36 43 48 106 
—3, 1, —-3, 1 91 114 90 210 
—1.2, 1, —1.2, 1 87 107 77 181 
—1.2, 1, 1.2, 1 48 57 46 100 
EROSEN 
—1.2, 1, 1,1, 1 (nm = 5) 117 150 132 278 
—1,..., ~1 (n = 10) 674 893 946 1940 
WATSON 
0,...,0(m =5) 37 39 34 69 
0,...,0(m = 10) 92 95 179 360 
POWER 
1,..., 1 (m = 20) 280 281 16 33 
1,..., 1 (n = 50) 539 540 30 61 
POWELL (n = 4) 
—3, -1, 0,1 48 49 28 57 
TRIG 
(n = 5) 20 22 20 41 
(n = 10) 35 37 44 89 
(n = 15) 57 59 100 201 
MANCINO 
(n = 10) 9 10 12 28 
(n = 20) 10 14 14 33 
(n = 30) 11 17 18 49 
BOUNDARY VALUE 
(n = 10) 28 30 25 51 
(n = 20) 56 58 48 97 
(n = 30) 86 88 121 243 
BROYDEN-TOINT 
-1,..., -I1(m = 10) 27 28 23 47 
-1,...,—1 (n = 20) 36 37 36 73 
—1,...,—-1 (nm = 30) 47 48 46 93 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service. ] 


SUBROUTINE CONMIN(N,X,F,G, IFUN, ITER, EPS,NFLAG,MXFUN,W, 
LIOUT,MDIM, IDEV, ACC, NMETH) 


AAQAAAAAAAAANAQAANQAAANAANARAANQANRANQAAANADANANAANANANAMAANAMAAANAANANAAMAMAAMNAAAAAAN AO 


PURPOSE: 


USAGE: 


PARAMETERS : 


SUBROUTINE CONMIN MINIMIZES AN UNCONSTRAINED NONLINEAR 
SCALAR VALUED FUNCTION OF A VECTOR VARIABLE X 

EITHER BY THE BFGS VARIABLE METRIC ALGORITHM OR BY A 
BEALE RESTARTED CONJUGATE GRADIENT ALGORITHM. 


CALL CONMIN(N,X,F,G, IFUN, ITER, EPS,NFLAG,MXFUN,W, 
LOUT,MDIM, IDEV, ACC, NMETH) 


N THE NUMBER OF VARIABLES IN THE FUNCTION TO 
BE MINIMIZED. 
».¢ THE VECTOR CONTAINING THE CURRENT ESTIMATE TO 


THE MINIMIZER. ON ENTRY TO CONMIN,X MUST CONTAIN 
AN INITIAL ESTIMATE SUPPLIED BY THE USER. 
ON EXITING,X WILL HOLD THE BEST ESTIMATE TO THE 
MINIMIZER OBTAINED BY CONMIN. X MUST BE DOUBLE 
PRECISIONED AND DIMENSIONED N. 
F ON EXITING FROM CONMIN,F WILL CONTAIN THE LOWEST 
VALUE OF THE OBJECT FUNCTION OBTAINED. 
F IS DOUBLE PRECISIONED. 
G ON EXITING FROM CONMIN,G WILL CONTAIN THE 
ELEMENTS OF THE GRADIENT OF F EVALUATED AT THE 
POINT CONTAINED IN X. G MUST BE DOUBLE 
PRECISIONED AND DIMENSIONED N. 
IFUN UPON EXITING FROM CONMIN,IFUN CONTAINS THE 
NUMBER OF TIMES THE FUNCTION AND GRADIENT 
HAVE BEEN EVALUATED. 
ITER UPON EXITING FROM CONMIN, ITER CONTAINS THE 
TOTAL NUMBER OF SEARCH DIRECTIONS CALCULATED 
TO OBTAIN THE CURRENT ESTIMATE TO THE MINIZER. 
EPS EPS IS THE USER SUPPLIED CONVERGENCE PARAMETER. 
CONVERGENCE OCCURS WHEN THE NORM OF THE GRADIENT 
IS LESS THAN OR EQUAL TO EPS TIMES THE MAXIMUM 
OF ONE AND THE NORM OF THE VECTOR X. EPS 
MUST BE DOUBLE PRECISIONED. 
NFLAG UPON EXITING FROM CONMIN,NFLAG STATES WHICH 
CONDITION CAUSED THE EXIT. 
IF NFLAG=0@, THE ALGORITHM HAS CONVERGED. 
IF NFLAG=1, THE MAXIMUM NUMBER OF FUNCTION 
EVALUATIONS HAVE BEEN USED. 
IF NFLAG=2, THE LINEAR SEARCH HAS FAILED TO 
IMPROVE THE FUNCTION VALUE. THIS IS THE 
USUAL EXIT IF EITHER THE FUNCTION OR THE 
GRADIENT IS INCORRECTLY CODED. 
IF NFLAG=3, THE SEARCH VECTOR WAS NOT 
A DESCENT DIRECTION. THIS CAN ONLY BE CAUSED 
BY ROUNDOFF,AND MAY SUGGEST THAT THE 
CONVERGENCE CRITERION IS TOO STRICT. 
MXFUN MXFUN IS THE USER SUPPLIED MAXIMUM NUMBER OF 
FUNCTION AND GRADIENT CALLS THAT CONMIN WILL 
BE ALLOWED TO MAKE. 
W W IS A VECTOR OF WORKING STORAGE.IF NMETH=@, 
W MUST BE DIMENSIONED 5*N+2. IF NMETH=1, 
W MUST BE DIMENSIONED N*(N+7)/2. IN BOTH CASES, 
W MUST BE DOUBLE PRECISIONED. 
IOUT IOUT IS A USER SUPPLIED OUTPUT PARAMETER. 
IF LOUT = @, THERE IS NO PRINTED OUTPUT FROM 
CONMIN. IF LOUT J @,THE VALUE OF F AND THE 
NORM OF THE GRADIENT SQUARED,AS WELL AS ITER 
AND IFUN,ARE WRITTEN EVERY IOUT ITERATIONS. 
MDIM MDIM IS THE USER SUPPLIED DIMENSION OF THE 
VECTOR W. IF NMETH=@,MDIM=5*N+2. IF NMETH=1, 
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: 


IDEV 


ACC 


NMETH 


MDIM=N*(N+7)/2. 

IDEV IS THE USER SUPPLIED NUMBER OF THE OUTPUT 
DEVICE ON WHICH OUTPUT IS TO BE WRITTEN WHEN 
LOUTIO. 

ACC IS A USER SUPPLIED ESTIMATE OF MACHINE 
ACCURACY. A LINEAR SEARCH IS UNSUCCESSFULLY 
TERMINATED WHEN THE NORM OF THE STEP SIZE 
BECOMES SMALLER THAN ACC. IN PRACTICE, 
ACC=1@.D-2@ HAS PROVED SATISFACTORY. ACC IS 
DOUBLE PRECISIONED. 

NMETH IS THE USER SUPPLIED VARIABLE WHICH 
CHOOSES THE METHOD OF OPTIMIZATION. IF 
NMETH=0,A CONJUGATE GRADIENT METHOD IS 

USED. IF NMETH#1, THE BFGS METHOD IS USED. 


IN ADDITION TO THE SPECIFIED VALUES IN THE ABOVE 
ARGUMENT LIST, THE USER MUST SUPPLY A SUBROUTINE 
CALCFG WHICH CALCULATES THE FUNCTION AND GRADIENT AT 
X AND PLACES THEM IN F AND G(1),...,G(N) RESPECTIVELY. 
THE SUBROUTINE MUST HAVE THE FORM: 


SUBROUTINE CALCFG(N,X,F,G) 
DOUBLE PRECISION X(N),G(N),F 


AN EXAMPLE SUBROUTINE FOR THE ROSENBROCK FUNCTION IS: 


SUBROUTINE CALCFG(N,X,F,G) 

DOUBLE PRECISION X(N),G(N),F,T1,T2 
T1=X(2)-X(1) *X(1L) 

T2=1.@-X(1) 

F=10@.QO*TL*T1+T2*T2 

G(1L)=-400. O*T1L*X(1)—-2. O*T2 
G(2)=2¢60.O*T1 

RETURN 

END 
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ALGORITHM 501 
Fortran Translation of Algorithm 409, 


Discrete Chebychev Curve Fit [E2] 


JOSEPH C. SIMPSON 


Miami University 


Key Words and Phrases: approximation, polynomial approximation, exchange algorithm, 
Chebychev approximation, Remez algorithm, minimax polynomial approximation 

CR Categories: 5.11, 5.13 

Language: Fortran 


DESCRIPTION 


Subprograms APPROX and EXCH fit N data pairs stored with independent vari- 
able values in array X and dependent variable values in array Y to a minimax 
polynomial of degree M with parity specified by variable K (0, mixed parity; 1, 
odd parity; 2, even parity). The polynomial coefficients are returned in ascending 
order in array A. The magnitude of floating point variable EPSH must be signifi- 
cant when compared with the one on the machine used. The algorithm will fail 
only if ABS(EPSH) is greater than HIZAX, the maximum approximation error. 
Success or failure of a run is indicated in the fixed point variable EQUAL. All 
other arguments are identical with the variables in the original algorithm and must 
conform to the constraints mentioned there. The variable NTAPE, an internal 
constant in subroutine APPROX, specifies the output unit number to which error 
messages will be directed. To insure the widest possible utility, a primitive level of 
Fortran was used. By modifying the code,.users with access to powerful compilers 
can reduce both the amount of code and execution time. In particular, the variable 
ITEMP can be eliminated. The algorithm has been used on Sigma 6, Sigma 9, and 
IBM 360RAX computers. 


ACKNOWLEDGMENT 


The author is indebted to Herbert Schmitt for suggestions which improved the sub- 
program. 
REFERENCES 
Scumirt, H. Discrete Chebychev curve fit, Algorithm 409. Comm. ACM 14, 5 (May 1971), 355-356. 


ALGORITHM 


SUBROUTINE APPROX(M, N, K, X, Y, EPSH, REF, MAXIT, HMAX, H, APP 18 
* A, EQUAL) APP 20 
C THIS SUBROUTINE, IN CONJUNCTION WITH SUBROUTINE EXCH, APP 38 


Received 18 March 1974, 

Copyright © 1976, Association for Computing Machinery, Inc. General permission to republish, 
but not for profit, all or part of this material is granted provided that ACM’s copyright notice is 
given and that reference is made to the publication, to its date of issue, and to the fact that 
reprinting privileges were granted by permission of the Association for Computing Machinery. 
During the time this algorithm was developed, the author was supported by the National Science 
Foundation and the Petroleum Research Fund. Computer facilities were provided by Marquette 
University. 

Author’s address: Academic Computer Service, Miami University, Oxford, OH 45056. 


ACM Transactions on Mathematical Software, Vol. 2, No. 1, March 1976, Pages 95-97. 


COLLECTED ALGORITHMS (cont.) 


ANIA AN AIANAANAIANANAANNDANAANANANANANAARANAANAANNAANAQAAANNAANINANAADANAAANQANRNANANRANR 


COMPUTES THE MINIMAX (CHEBYCHEV) POLYNOMIAL WHICH FITS 
THE DATA IN X AND Y. 
THIS SUBPROGRAM IS A TRANSLATION FROM ALGOL OF 
H. SCHMITT*S ALGORITHM NUMBER 499 IN CACM, V14, 
PP. 355~356(1971). 
THE PRIMARY REFERENCE IS STIEFEL, E. L. NUMERICAL 
METHODS OF CHEBYCHEV APPROXIMATION, IN *ON NUMERICAL 
APPROXIMATION*, R. LANGER, (EDITOR), UNIVERSITY OF 
WISCONSIN PRESS, 1958, PP.217-232. 
TRANSLATION BY JOSEPH C. SIMPSON, MARQUETTE UNIVERSITY. 
THE EXCHANGE ALGORITHM IS A FINITE ITERITIVE PROCESS 
REQUIRING, AT MOST, BICO(N,P) ITERATIONS, WHERE P = 
NUMBER OF POINTS FIT IN ONE ITERATION (SEE EXCH FOR THE 
VALUE OF P). SINCE BICO(N,P) CAN BE VERY LARGE, IT IS 
POSSIBLE THAT THE ROUTINE WILL NOT CONVERGE WITHIN MAXIT 
ITERATIONS. THE OTHER POSSIBILITY OF FAILURE OCCURS 
WHEN INSUFFICIENT FLOATING POINT PRECISION IS AVAILABLE 
FOR THE INPUT DATA CHOSEN. 
DESCRIPTION OF INPUT-OUTPUT VARIABLES. 
DEGREE OF FITTING POLYNOMIAL. 
NUMBER OF DATA POINTS STORED IN X AND Y. 
INDEPENDENT VARIABLE VALUES STORED IN ASCENDING ORDER. 
DEPENDENT VARIABLE VALUES CORRESPONDING TO ABOVE DATA. 
CONTROLS THE CHARACTER OF THE POLYNOMIAL. 
= @ IMPLIES MIXED PARITY POLYNOMIAL. X(1) MAY BE ANY 
LOATING POINT VALUE. 
= 1 IMPLIES ODD POLYNOMIAL. X(1) MUST BE .GT.@. 
= 2 IMPLIES EVEN POLYNOMIAL. X(1) MUST BE .GE.@. 
EPSH. ABS(EPSH) = TOLERENCE FOR LEVELING. IF EPSH IS 
NEGATIVE, REF CONTAINS THE INITIAL POINT SET. ABS(EPSH) 
SHOULD BE SIGNIFICANT WHEN COMPARED WITH ONE. A USEFUL 
VALUE FOR 24 BIT MANTISSA IS EPSH=2.E-7. 
REF = AN ARRAY OF INITIAL POINTS IF EPSH.LT.@. OTHERWISE 
IT IS NOT AN INPUT ARRAY. UPON RETURN IT CONTAINS THE 
MAXIMUM DEVIATION POINTS. 
MAXIT = UPPER LIMIT FOR NUMBER OF EXCHANGE STEPS. 
HMAX CONTAINS THE MAXIMUM DEVIATION (OUTPUT) . 
H CONTAINS THE APPROXIMATION ERRORS (OUTPUT). 
A CONTAINS THE POLYNOMIAL COEFFICIENTS IN ORDER OF 
INCREASING POWERS(OUTPUT). IF MAXIT IS EXCEEDED, REF 
CONTAINS A NEW REFERENCE SET. 
DIMENSION REF(REFMAX) ,DAA(M+1) ,D(M+2) ,Z(M+4) ,A(M41), 
AA(M+1) ,C(M+2) ,X(N) ,¥(N) ,H(N) 
REFMAX (K=@)=M+2. REFMAX(K=1) =INT((M+3)/2). 
REFMAX (K=2) =2+M/2. 
INPUT VARIABLES ALTERED DURING EXECUTION CAN INCLUDE M, 
EPSH,REF. 
EQUAL RECORDS THE SUCCESS OR FAILURE OF THE ALGORITHM. 
EQUAL=1 SUCCESFUL. 
EQUAL=@ CONVERGENCE OF EXCHANGE PROCESS NOT ACHEIVED. 
EQUAL=-1 INPUT ERROR. 
EQUAL=~2 ALGORITHM FAILURE. NOTE.. A MAY CONTAIN THE 
COLLOCATION POLYNOMIAL. 
DESCRIPTION OF SOME LOCAL VARIABLES. 

SMALLEST REPRESENTABLE NUMBER. IT IS USED ONLY WHEN 
COLLOCATION IS ENCOUNTERED. 
THE FOLLOWING VARIABLES ARE DECLARED INTEGER, BUT ARE USED 
AS LOGICAL VARIABLES ONLY, .TRUE.=1 AND .FALSE.*¢ 
K®,K1,B1,B2. 
Z(I+1) CONTAINS THE ITH POINT OF THE CURRENT REFERENCE 
SET. DAA(I+1) CONTAINS THE CORRECTIGN TO THE COEFFICIENT 
OF x**(I). 
TO OBTAIN A DOUBLE PRECISION VERSION, CHANGE THE 
REAL DECLARATION TO DOUBLE PRECISION, ABS TO DABS, COS 
TO DCOS, AND FLOAT TO DFLOAT. 
THIS DIMENSION STATEMENT ALLOWS 5@ POINTS AND A MIXED 
ORDER POLYNOMIAL OF DEGREE 38. 

DIMENSION XX(5@), AA(31), DAA(31), D(32), 2(34), C(32) 

DIMENSION X(1), Y(1), H(1), REF(1), A(1) 

DOUBLE PRECISION SD, QD, C, T, D, DT, AA, DAA, XX, MAX 

REAL EPSH, HMAX, Y, H, A, PI, Q, S, Xl, XA, XE, COS 

INTEGER N, M, K, MAXIT, REF, I, J, P, Ql, Q2, R, KO, Kl, Bl, 

* B2, Z, ITEMP, MOLD, HIGH, JJ, II, LOW, EQUAL, NTAPE, B3 
MACHINE DEPENDENT CONSTANTS. 
NTAPE IS THE PRINTER UNIT NUMBER. 


RADARK KM AE 


NTAPE = 6 
PI = 3.1415926535 
MOLD = M 


ZERO THE COEFFICIENT ARRAY. 
IF (K-1) 10, 20, 39 

16 K® = 
Kl = 

Ql = 


26 KO 
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COLLECTED ALGORITHMS (cont.) 


aNd 


i) 
g 
2 
A 


Cs NO eel 


CCORDING TO THE VALUE OF K 
49 M = (M-Q1)/2 
50 P=M +2 
SCREEN INPUT PARAMETERS. 
IF (P-N) 68, 60, 786 
60 IF (M) 780, 70, 70 
70 IF (K-1) 180, 80, 90 
80 IF (X(1)) 798, 798, 108 
99 IF (X(1)) 798, 108, 106 
190 DO 128 1=2,N 
ITEMP = I - 1 
IF (X(I)-X(ITEMP)) 8808, 110, 110 
118 CONTINUE 
12@ CONTINUE 
ITEMP = MOLD + 1 
DO 13@ I=1,ITEMP 
A(I) = @. 
138 CONTINUE 
Z(1) = @ 
ITEMP = P + 2 
Z(ITEMP) = N + 1 
IF (EPSH) 148, 170, 170 
IF EPSH.GT.@, BRANCH TO Z SETUP SECTION. 
IF EPSH IS NEGATIVE, TEST REF AND LOAD IT INTO 2. 
140 EPSH = -EPSH 
J=@ 
DO 16% I=1,P 
ITEMP = I + 1 
R = REF(I) 
Z(ITEMP) = R 
BRANCH TO ERROR EXIT UNLESS REF IS MONOTONICALLY 
INCREASING. 
IF (J-Kk) 150, 818, 819 
150 J=R 
168 CONTINUE 
IF (J-N) 300, 300, 810 
BRANCH AROUND Z SETUP SECTION. 
THIS SECTION LOADS 2 WITH THE POINTS CLOSEST TO THE 
CHEBYCHEV ABSCISSAS. 
178 X1 = X(1) 
XE = X(N) 
IF (K@) 198, 190, 180 
IF THE POLYNOMIAL IS NOT MIXED, I.E.HAS A DEFINITE PARITY, 
BRANCH TO 20. 
180 XA = XE + Xl 
XE = XE - Xl 
Q = PI/FLOAT(M+1) 
GO TO 200 
190 XA = @. 
XE = XE + XE 
ITEMP = 2*(M+1) + Ql 
Q = PI/FLOAT(ITEMP) 
CALCULATE THE JTH CHEBYCHEV ABSCISSA AND LOAD Z(J+1) WITH 
THE APPROPRIATE INDEX FROM THE DATA ABSCISSAS. 
208 DO 270 JJ=1,P 
ae ae ae ees Fh 
Xl = XA + XE*(COS(Q*FLOAT(P-J) )) 
ITEMP = J + 2 
R = Z2(ITEMP) 
HIGH = R - 1 
IF (HIGH-2) 230, 210, 210 
210 DO 220 I1=2,HIGH 
T= HIGH 4/9 =: “Ta 
ITEMP = I - 1 
IF (X(1)+X(ITEMP)-X1) 240, 240, 220 
WHEN THE CHEBYCHEV ABSCISSA IS BRACKETED BY TWO INPUT 
ABSCISSAS, BRANCH TO 240. 
220 CONTINUE 
2308 I=l1 
240 ITEMP = J +1 
IF (I-R) 250, 260, 260 
250 Z(ITEMP) = I 
GO TO 270 
260 Z(ITEMP) =k - 1 
278 CONTINUE 
IF THE LOWER CHEBYCHEV ABSCISSAS ARE LESS THAN X(1), LOAD 
THE LOWER ELEMENTS OF Z WITH THE LOWEST POINTS. 
J = 2 
280 J=J+1 
ITEMP = J + 1 
IF (Z(ITEMP)-J) 290, 300, 300 
290 Z(ITEMP) = J 


GO TO 280 
Ml ENTRY. INITIALIZE VARIABLES TO PREPARE FOR EXCHANGE 
ITERATION. 


300 ITEMP = M+ 1 
ZERO THE AA ARRAY. 
DO 316 I=1,ITEMP 
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11398 
1148 
1158 
1168 
1178 
1188 
1198 
1260 
1218 
1220 
12308 
1246 
1250 
1266 
1270 
1288 
1298 
1386 
1319 
1328 
1338 
13498 
1358 
13698 
1378 
1388 
139@ 
1486 
1418 
1420 
1436 
1448 
145@ 
1468 
1478 
1488 
1496 
1560 
1518 
15298 
153 
1548 
1558 
1566 
1576 
1580 
1598 
1608 
1618 
1620 
1638 
1648 
1658 
1668 
1678 
1686 
1698 
1760 
1718 
17206 
173 

17408 
1758 
1760 
1770 
1766 
17968 
1820 
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1828 
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1846 
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COLLECTED ALGORITHMS (cont.) 


AA(I) = 
31@ CONTINUE 


A200 


DO 34@ I=1 
H(t) = ¥ 
Q = X(T) 
IF (KO) 
320 XX(I) = 
GO TO 34 
330 XX(I) = 
348 CONTINUE 
Bl 


w 
N 
| 


T = 
C ITERATION ENTR 
35@ R=R+1 
s=l. 
C COMPUTATION OF 
IF (Kl) 38 
C IF THE POLYNOM 
368 DO 378 I=1 
Ss = -S 
ITEMP = 
J = Z(1IT 
Q = X(J) 
C(I) = ( 
D(I) = S 
378 CONTINUE 
GO TO 408 
388 DO 398 I=1 
S = -S 
ITEMP 
ITEMP 
C(I) =H 
D(I) =S 
398 CONTINUE 
406 CONTINUE 
DO 420 I=2 
DO 418 J 
J =P 
ITEMP 
ITEMP 
QD = X 
ITEMP 
ITEMP 
QD = Q 
ITEMP 
C(J) = 
D(J) = 
419 CONTINUE 
426 CONTINUE 
DT = -C(P) 
T = T + DT 
C COMPUTATION OF 
HIGH = M + 
DO 458 II= 
I = HIGH 
ITEMP = 


THE POLYNOMIAL IS MIXED. 
LOAD XX WITH THE SQUARES OF THE ABSCISSAS. 


Q. 


LOAD H WITH THE ORDINATES AND XX(1) WITH THE ABSCISSAS IF 
IF THE POLYNOMIAL IS EVEN OR ODD 


iN 
(T) 


320, 326, 332 
Q*Q 

Y) 

Q 


Y. R IS THE ITERATION INDEX. 


DIVIDED DIFFERENCES SCHEME. 
0, 386, 368 
IAL IS ODD, BRANCH TO 388. 


1P 
I+i1 
EMP) 
H(J)+S*T)/Q 
/Q 
7P 
I+ 1 
2 (ITEMP) 
(ITEMP) + S*T 
7P 
J=1I,P 
+ I - JJ 
=J+] 
= Z(ITEMP) 
X (ITEMP) 
=2+d- I 
= Z(ITEMP) 
D - XX(ITEMP) 
=J- 1 
(C(J) -C (ITEMP) ) /QD 
(D(J)-D(ITEMP) ) /QD 


/D(P) 


POLYNOMIAL COEFFICIENTS. 
1 

1,HIGH 

- II 

I+1 


DAA(ITEMP) = C(ITEMP) + DT*D(ITEMP) 


ITEMP = 
ITEMP = 
QD = XX( 
LOW = I 


I + 2 
Z(ITEMP) 
ITEMP) 
+] 


IF (M-LOW) 458, 430, 438 


4308 DO 448 J 
JJ =J 
DAA (J) 


=LOW,M 
+ 1 
= DAA(J) - QD*DAA(JJ) 


448 CONTINUE 


456 CONTINUE 
DO 46@ I=l 
AA(I) = 
46@ CONTINUE 
C EVALUATION OF 
C ERRORS. 
MAX = @. 
DO 548 I=1 
SD = AA( 
QD = XXx( 
IF (-M) 
476 DO 488 J 
J=M 
SD = S$ 
489 CONTINUE 
499 CONTINUE 
IF (Kl) 
C IF THE POLYNOM 


+ HIGH 
AA(I) + DAA(T) 


THE POLYNOMIAL TO GET THE APPROXIMATION 


iN 

HIGH) 

I) 

470, 498, 490 
J=1,M 

- JJ +1 

D*QD + AA(J) 


518, 518, 588 
IAL IS ODD MULTIPLY SD BY X(I). 


APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 


18698 
1878 
1886 
1898 
1908 
1918 
1920 
1936 
1948 
1958 
1966 
1970 
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1996 
2000 
28616 
20208 
2838 
2048 
2058 
2068 
2076 
2680 
2090 
2106 
2118 
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COLLECTED ALGORITHMS (cont.) 501-P 5- 90 


508 SD = SD*X(I) APP 2760 
518 QD = ¥(I) - SD APP 2779 
H(I) = QD APP 2788 

IF (DABS(QD)-MAX) 538, 530, 520 APP 2790 

C LOAD MAX WITH THE LARGEST MAGNITUDE OF THE APPROXIMATION APP 2809 
C ARRAY. APP 2816 
528 MAX = DABS(QD) APP 2820 
530 CONTINUE APP 2830 
548 CONTINUE APP 2846 

C TEST FOR ALTERNATING SIGNS. APP 2856 
ITEMP = 2(2) APP 2868 

IF (H(ITEMP)) 558, 560, 608 APP 2876 

550 J = 1 APP 2880 
GO TO 618 APP 2896 

560 J = @ APP 2908 

C THIS REPRESENTS A CASE WHERE THE POLYNOMIAL EXACTLY APP 2910 
C PREDICTS A DATA POINT. APP 2928 
WRITE (NTAPE,99998) APP 2936 

IF (B3) 570, 578, 690 APP 2940 

57@ B3 =1 APP 2958 
IF (EPSH-MAX) 588, 716, 710 APP 2968 

580 WRITE (NTAPE,99999) APP 2978 
LOW = (N+1)/2 - (P+1)/2 +1 APP 2986 

HIGH = LOW + P APP 2990 

DO 598 I=LOW, HIGH APP 3000 

zZ(I) =I -1 APP 30108 

5968 CONTINUE APP 3020 
GO TO 350 APP 3030 

600 J = -1 APP 3040 
618 CONTINUE APP 3050 
DO 67@ I=2,P APP 3060 

ITEMP = I + 1 APP 3670 

ITEMP = Z(ITEMP) APP 3080 

C IF(H(ITEMP)) 339,340,341 APP 3990 
IF (H(ITEMP)) 628, 568, 630 APP 3198 

626 JJ = -l APP 3119 
GO TO 648 APP 3120 

6306 JJ =1l APP 3130 
649 IF (J-JJ) 650, 660, 650 APP 3149 

C ERROR ENTRY. INSUFFICIENT ACCURACY FOR CALCULATION. APP 3150 
656 Bl=l APP 3160 
GO TO 726 APP 3170 

660 Je=-d APP 3188 
670 CONTINUE APP 3190 

C SEARCH FOR ANOTHER REFERENCE. APP 3206 
CALL EXCH(N, P, H, EPSH, Z, EQUAL) APP 3219 

IF (EQUAL) 688, 680, 720 APP 3220 

686 IF (R-MAXIT) 350, 700, 700 APP 3230 
699 B3 = -1 : APP 3240 
GO TO 728 APP 3250 

700 B2 = APP 3266 
GO TO 726 APP 3276 

718 WRITE (NTAPE,99988) MAX APP 3288 

C END ‘OF ITERATION LOOP. APP 3298 
C M2 ENTRY. LOAD OUTPUT VARIABLES AND RETURN. APP 3390 
726 HIGH = M +1 APP 3310 

C LOAD THE COEFFICIENTS INTO THE A ARRAY. APP 3326 
DO 738 I=1,HIGH APP 3338 

ITEMP = Q1] + Q2*(I-1) +1 APP 3340 
A(ITEMP) = AA(I) APP 3350 

738 CONTINUE APP 3360 

C LOAD REF WITH THE FINAL REFERENCE POINTS. APP 3370 
DO 748 I=1,P APP 3388 

ITEMP = I +1 APP 3390 

REF(I) = Z(ITEMP) APP 3490 

748 CONTINUE APP 3419 
HMAX = MAX APP 3420 

MAXIT = R APP 3430 

IF (B3) 848, 750, 758 APP 3440 

750 IF (Bl) 760, 768, 820 APP 3456 
760 IF (B2) 770, 778, 830 APP 3460 
778 M = MOLD APP 3470 

C NORMAL EXIT APP 3489 
RETURN APP 3490 

C ERROR EXITS. APP 35006 
780 WRITE (NTAPE,9999Q) APP 3510 
WRITE (NTAPE,99996) N, MOLD, K APP 3526 

EQUAL = -1 . APP 3530 

GO TO 770 APP 3540 

798 WRITE (NTAPE,9999Q) APP 3550 
WRITE (NTAPE,99995) K, X(1) APP 3560 

EQUAL = -1 APP 3570 

GO TO 770 APP 3580 

800 WRITE (NTAPE, 99992) APP 3598 
WRITE (NTAPE,99994) (X(I),I=1,N) APP 3696 
EQUAL = -1 APP 3619 

GO TO 778 APP 3620 

819 WRITE (NTAPE, 99998) APP 3630 
WRITE (NTAPE,99993) (REF(I) ,I=1,N) APP 3640 

EQUAL = -1 APP 3658 


GO TO 778 APP 3669 


COLLECTED ALGORITHMS (cont.) 


82@ WRITE (NTAPE, 99997) 
WRITE (NTAPE,99992) HMAX 
EQUAL = ~2 
GO TO 778 

838 WRITE (NTAPE,99997) 

ITEMP = M + 2 
WRITE (NTAPE,99991) MAXIT, (REF(I) ,I=1,ITEMP) 
EQUAL = 9 
GO TO 778 
840 WRITE (NTAPE,99997) 
WRITE (NTAPE, 99989) 
EQUAL = -2 
GO TO 778 


99999 FORMAT (LH+, 26X, 35HONE MORE ATTEMPT WILL BE MADE USING, 


* 19H THE MIDDLE POINTS.) 
99998 FORMAT (25H COLLOCATION HAS OCCURRED.) 
99997 FORMAT (26H ALGORITHM APPROX FAILURE.) 


99996 FORMAT (16X, 28HINSUFFICIENT. INFORMATION. N=, 13, 3H M=, 


* 3H K=, I3) 


99995 FORMAT (1@X, 37HPOLYNOMIAL PARITY - ABSCISSA CONFLICT., 


* 6H K = , I3, 7H X(1)=, F20.10) 


99994 FORMAT (10X, 4@HABSCISSAS OUT OF ORDER. X ARRAY EQUALS 


* /(7E17.7)) 


99993 FORMAT (10X, 4@HINITIAL POINT ARRAY NOT MONOTONIC INCREA, 


* 23HSING. REF ARRAY EQUALS/ (1319) ) 


99992 FORMAT (1X, 39HAPPROXIMATION ERRORS AT POINTS OF REFER, 
* 30HENCE DO NOT ALTERNATE IN SIGN./23H SUSPECT INSUFFICIENT W, 
* J1IHORD LENGTH., 16H MAXIMUM ERROR= , E15.7/14H IF POLYNOMIAL, 
* 34H WAS ASSUMED TO BE OF MIXED PARITY, 18H, CHECK FOR EVEN O, 


* 13HR ODD PARITY.) 


9999] FORMAT (31H MAXIMUM NUMBER OF ITERATIONS, , I6, 16H THE REFER, 


* 23HENCE ARRAY OBTAINED IS /(1319)) 
99998 FORMAT (31H INPUT ERROR SUBPROGRAM APPROX.) 
99989 FORMAT (1H+, 26X, 18HAPPROX TERMINATES.) 


99988 FORMAT (1H+, 26X, 6H MAX= , E15.7, 23H .LT.HMIN. NORMAL EXIT, 


* 1H.) 
END 


SUBROUTINE EXCH(N, P, H, EPSH, Z, EQUAL) 
DIMENSION H(N) ,Z2(P+2) 
N = NUMBER OF POINTS. 
P = NUMBER OF REFERENCE POINTS. 
EPSH = APPROXIMATION ERROR STANDARD. 
Z= INPUT OLD REFERENCE INDICES. 
OUTPUT NEW REFERENCE INDICES. 
2(1) SHOULD CONTAIN ZERO. 
Z(P+2) SHOULD CONTAIN (N+l). 
Z(I+1) CONTAINS THE ITH REFERENCE POINT INDEX. 
KR = ARRAY OF APPROXIMATION ERRORS. 
EQUAL = @ IMPLIES NORMAL EXCHANGE. 

EQUAL = 1 IMPLIES OLD AND NEW REFERENCE SETS ARE EQUAL. 
THE APPROXIMATION ERRORS ARE COMPARED RELATIVE TO EPSH. 
DESCRIPTION OF SOME LOCAL VARIABLES. 

HZ1 CONTAINS THE LOW POINT APPROXIMATION ERROR. 

HZP CONTAINS THE HIGH POINT APPROXIMATION ERROR. 

MAXR CONTAINS THE LARGEST APPROXIMATION ERROR ABOVE THE 
REFERENCE POINT SET. INDR IS THE POINT INDEX FOR MAXR. 
MAXL CONTAINS THE LARGEST APPROXIMATION ERROR BELOW THE 
REFERENCE POINT SET. INDL IS THE POINT INDEX FOR MAXL. 


CODING FOR HIGHER LEVEL FORTRAN COULD ELIMINATE ITEMP. 

TO OBTAIN A DOUBLE PRECISION VERSION, CHANGE THE REAL 

DECLARATION TO DOUBLE PRECISION AND ABS TO DABS. 
DIMENSION 2Z(1), H(1) 


AAANAAAANAANANNAAANAAANANRANANANANAD 


ITEMP IS A FIXED POINT VARIABLE USED FOR TEMPORARY STORAGE 


I3, 


INTEGER Z, N, P, I, J, L, INDEX, INDL, INDR, ZE, ITEMP, LOW, 


* HIGH, EQUAL, II 

REAL EPSH, H, HZ1, HZP, MAX, MAXL, MAXR, SIG 

EQUAL = @ 

L = 9 

ITEMP = 2(2) 
C ARBITRARILY CHOSEN EQUAL TO THE SIGN OF THE INPUT POINT. 
C THIS WILL BE ADJUSTED LATER IF NECESSARY. 

IF (H(ITEMP)) 18, 16, 28 


1@ SIG = l. 
GO TO 30 
28 SIG = -l. 


38 DO 99 I=1,P 
DO 98 PRESCANS Z TO INSURE IT IS A PROPER CHOICE, I. E. 
RESETS Z IF NECESSARY SO THAT MAXIMUM ERROR POINTS ARE 
CHOSEN, GIVEN THE SIGN CONVENTION MENTIONED ABOVE. 
IN ORDER TO WORK PROPERLY, THIS SECTION REQUIRES Z(1)=9 
AND Z(P+2)=N+1. 
MAX = @. 
SIG = -SIG 
ITEMP = I + 2 
ZE = Z(ITEMP) - 1 
LOW = 2(I) + 1 
C SCAN THE OPEN POINT INTERVAL CONTAINING ONLY THE ITH 
C INITIAL REFERENCE POINT. IN THE INTERVAL PICK THE 


AAAAN 


APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 
APP 


EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
EXC 
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C POINT WITH LARGEST MAGNITUDE AND CORRECT SIGN. 
SIG CONTAINS THE 


C THE SORTING OCCURS IN THIS SECTION. 
C SIGN ASSUMED FOR H(I). 
DO 66 J=LOW,ZE 
IF (SIG*(H(J)-MAX)) 58, 58, 48 


48 MAX = H(J) 
INDEX = J 
58 CONTINUE 


68 CONTINUE 
ITEMP = I +1 
ITEMP = Z(ITEMP) 
MAXL = ABS (MAX) 
IF (ABS (MAX-H(ITEMP))/MAXL-EPSH) 88, 


MOST OF 


80, 78 


C IF THE MAX ERROR IS SIGNIFICANTLY GREATER THAN THE INPUT 


C POINT SWITCH TO THIS POINT. 
78 ITEMP = I + 1 
Z(ITEMP) = INDEX 
L=l 
89 CONTINUE 
98 CONTINUE 
MAXL = @. 
MAXR = Q@. 
ITEMP = P + 1 
LOW = Z(ITEMP) + 1 
IF (LOW-N) 100, 100, 148 
188 CONTINUE 


C FIND THE ERROR WITH LARGEST ABSOLUTE VALUE AND PROPER SIGN 
C FROM AMONG THE POINTS ABOVE THE LAST REFERENCE POINT. 
C THIS SECTION IS NECESSARY BECAUSE THE SET OF POINTS CHOSEN 
C MAY BEGIN WITH THE WRONG SIGN ALTERNATION. 
DO 138 J=LOW,N 
IF (SIG*(MAXR-H(J))) 120, 128, 118 
116 MAXR =. H(J) 
INDR = J 
129 CONTINUE 
138 CONTINUE 
149 CONTINUE 
C FIND THE ERROR WITH LARGEST ABSOLUTE VALUE AND PROPER SIGN 
C FROM AMONG THE POINTS BELOW THE FIRST REFERENCE POINT. 
C THIS SECTION IS NECESSARY BECAUSE THE SET OF POINTS CHOSEN 
C MAY BEGIN WITH THE WRONG SIGN ALTERNATION. 


ITEMP = 2(2) 

HZ1 = H(ITEMP) 

HIGH = ITEMP - 1 

IF (HIGH) 230, 230, 158 
15@ CONTINUE 

IF (HZ1) 168, 176, 188 
16@ SIG = -l. 

GO TO 198 
176 SIG = @. 

GO TO 198 
18@ SIG = l. 
198 CONTINUE 

DO 229 J=1,HIGH 

IF (SIG*(MAXL-H(J))) 218, 210, 208 
208 MAXL = H(J) 
INDL = J 

218 CONTINUE 
228 CONTINUE 
238 CONTINUE 

MAXL = ABS (MAXL) 

MAXR = ABS (MAXR) 

HZ1 = ABS (HZ1) 

ITEMP = P + 1] 

ITEMP = Z(ITEMP) 

HZP = ABS (H(ITEMP) ) 


C MAXL AND MAXR CONTAIN THE MAGNITUDE OF THE SIGNIFICANT 


C ERRORS OUTSIDE THE REFERENCE POINT SET. 


IF EITHER IS 


C ZERO, THE REFERENCE POINT SET EXTENDS TO THE END POINT 


a 


ON THAT SIDE OF THE INTERVAL. 
IF (L) 298, 246, 298 


C L=@ IMPLIES THAT THE PRESCAN OF DO 9@ DID NOT CHANGE ANY 
C POINTS.IF L=@ AND MAXL AND MAXR ARE NOT SIGNIFICANT WHEN 
C COMPARED WITH UPPER AND LOWER REFERENCE POINT ERRORS, 
c 


RESPECTIVELY, USE THE EQUAL EXIT. 
240 IF (MAXL) 250, 268, 259 


256 IF (EPSH-(MAXL-HZP)/MAXL) 298, 260, 260 


268 IF (MAXR) 270, 288, 276 


270 IF (EPSH-(MAXR-HZ1)/MAXR) 2968, 288, 2886 


C EQUAL BRANCH POINT. 

286 EQUAL = 1 

RETURN 

C ENTER HERE IF ANY CHANGES HAVE BEEN MADE. THEN TEST TO 
C SEE IF A POINT OUTSIDE THE PRESET POINT SET SHOULD BE 
C INCLUDED. IF NOT, RETURN. 

290 IF (MAXL) 32@, 3608, 328 

300 IF (MAXR) 328, 318, 328 
C RETURN BRANCH (END). 


316 CONTINUE 
RETURN 
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C IF A POINT OUTSIDE THE PRESENT REFERENCE SET MUST BE EXC 1420 
C INCLUDED, (I.E. THE SIGN OF THE FIRST POINT, ASSUMED IN EXC 1438 
C THE DO 98 SECTION IS WRONG) SHIFT TO THE SIDE OF LARGEST EXC 1448 
€ RELATIVE ERROR FIRST. EXC 145@ 
C CHECK THE OTHER SIDE. EXC 1468 
320 IF (MAXL-MAXR) 358, 358, 330 EXC 1470 
330 IF (MAXL-HZP) 348, 348, 420 EXC 1480 
340 IF (MAXR-HZ1) 318, 378, 379 EXC 1496 
350 IF (MAXR-HZ1) 368, 360, 378 EXC 1500 
360 IF (MAXL~-HZP) 318, 420, 426 EXC 1518 

C SHR ENTRY. EXC 1528 
C THIS SECTION INSERTS A POINT FROM ABOVE THE PRESCAN EXC 1538 
C POINT SET. Exc 1548 
378 INDEX = 2(2) EXC 1558 
DO 388 I=2,P EXC 1560 

C SHIFT POINT SET DOWN, DROPPING THE LOWEST POINT. EXC 1578 
ITEMP = I + 1 EXC 1588 
z({I) = Z(ITEMP) EXC 1598 

388 CONTINUE EXC 1668 

; ITEMP = P + 1 EXC 1616 
C ADD THE NEW HIGH POINT. EXC 1628 
Z(ITEMP) = INDR EXC 1630 

IF (MAXL) 318, 318, 398 EXC 1648 
C IF MAXL=@8, RETURN. EXC 1654 
C IF MAXL.GT.@ REPLACE REFERENCE POINTS FROM THE LEFT, EXC 166@ 
C STOPPING THE FIRST TIME THE CANDIDATE FOR REPLACEMENT IS EXC 1670 
C GREATER IN MAGNITUDE THAN THE PROSPECTIVE REPLACEE. EXC 1688 
C ALTERNATION OF SIGNS IS PRESERVED BECAUSE NON~REPLACEMENT ExC 1698 
C IMMEDIATLY TERMINATES THE PROCESS. EXC 1788 
39@ DO 418 I=2,P EXC 17198 
ITEMP = 2(1) EXC 1720 

IF (ABS(H(INDL))-ABS(H(ITEMP))) 310, 4608, 488 EXC 1736 

402 J = 2(T) EXC 1748 
Z2(I) = INDL ExC 1758 

INDL = INDEX EXC 1768 

INDEX = J EXC 1776 

418 CONTINUE EXC 1788 
GO TO 318 EXC 1798 

C ENTRY SHL. THIS SECTION INSERTS A POINT FROM BELOW THE EXC 1808 
C PRESCAN POINT SET. EXC 1816 
426 ITEMP = P + l EXC 1828 
INDEX = Z2(ITEMP) EXC 1838 

C SHIFT REFERENCE POINT SET UP BY ONE. EXC 1848 
DO 436 II=2,P EXC 1858 
I=P+2-I EXC 1868 

ITEMP = I + 1 Exc 1879 

430 CONTINUE EXC 189@ 

C STORE LOWEST POINT IN Z(2) EXC 1988 
Z2(2) = INDL Exc 1914 

IF (MAXR) 318, 318, 448 EXC 1928 

C IF MAXR=@, RETURN. EXC 1938 
C IF MAXR.GT.@, START REPLACING REFERENCE POINTS FROM RIGHT, EXC 1948 
C STOPPING THE FIRST TIME THE CANDIDATE FOR REPLACEMENT EXC 1958 
C IS GREATER IN MAGNITUDE THAN THE PROSPECTIVE REPLACEE. EXC 1968 
448 DO 468 II=2,P EXC 1978 
I=pPp+2- II EXC 1988 

ITEMP = I + 1] EXC 1996 

HIGH = Z(ITEMP) EXC 2000 

IF (ABS (H(INDR)-ABS(H(HIGH)))) 3108, 4508, 458 EXC 20186 

450 J = Z{(ITEMP) EXC 2026 
Z(ITEMP) = INDR EXC 2030 

INDR = INDEX EXC 2048 

INDEX = J EXC 2058 

46@ CONTINUE EXC 2060 
GO TO 318 EXC 2678 

END EXC 2088 


‘ACM Transactions on Mathematical Software, Vol. 4, No. 1, March 1978, Page 95. 
REMARK ON ALGORITHM 501 


Fortran Translation of Algorithm 409. Diserete Chebychev Curve Tit [E2] 
[Joseph C. Simpson, ACA Trans. Math. Software 2, 1 (March 1976), 95-97] 


R. Tutrell [Reed 16 February 1977] 
Harris Corporation, P.O. Box 37, \lelbourne, I'L 32901 


~The following should be inserted just above the statement labeled 430 in subroutine 
EXCH: 

ZUTEMP) = Z(t) EXC 1880 
With this correction this algorithm has been used to fit first, second, and third 
degree curves to experimental data on the following machines: Harris SLASH 35, 
Honeywell 600 series, and Univac 1108. 


1 Subroutine EXCH is published in the ‘‘Collected Algorithms from ACM’’; to insert line 
EXC 1880, see page 501-P8-R1 
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ALGORITHM 502 
Dependence of Solution of Nonlinear 
Systems on a Parameter [C5] 


MILAN KUBICEK 


Prague Institute of Chemical Technology, Czechoslovakia 


Key Words and Phrases: solution of nonlinear equation, differentiation with respect to a 
parameter, one-parameter imbedding, dependence on parameter 

CR Categories: 5.15 

Language: Fortran 


DESCRIPTION 


The Fortran algorithm DERPAR is a subroutine suitable for evaluation of the 
dependence of the solution 1, ..., ¢, of a system of equations 


Si(ai, ...,%n, a) = 0 
: (1) 

Sn (1, see) Ln; a) = 0 
on the parameter a. The modified method of Davidénko [1, 2, 3], which applies 
the implicit function theorem, is used in combination with the Newton method and 
Adams integration formulas. A similar procedure was used by Deist and Sefor [4], 
who made use of an introduced parameter. 

To establish the dependence x(a), the following set of differential equations can 
be derived: 


= = —I-'(z, a) _ x (ao) = Xo. (2) 


Here 


T 
7 of; of _ of; Ofn = 
es seh da (2 ree v2) af I Meas 6) ee D 


If '(a(a@), a) is.a regular matrix for (ao, a1), then x(a) obtained by integration of 
(2) satisfies 


f(a(a), a) = 0, a € (ao, a1). (3) 


However, at a branching point the matrix T is singular and the integration pro- 
cedure mentioned above fails. 

Therefore, the method must be adapted to be able to handle branching points, 
i.e. to evaluate the whole dependence x(a), which is a continuously smooth curve 
in the (n + 1)-th dimensional space (x — a). A parameterization with respect to 
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the are length of the solution locus seems to be a powerful technique which over- 
comes the difficulties [51]. 
Differentiation of eq. (1) with respect to ¢ gives 
df; of: dz; , afida 


a ——=0, 1=1,2,...,n. 4 
di “aa,dt * da dt : 7 (4) 


An additional equation 


2 2 2 
dx, 2 da 
2 eae oe —j=1 i) 
(GB) +--+ (G) +(4) (5) 
determines the parameter ¢ as the arc length of the curve x(a) in the space (4 — a). 
The initial conditions for eqs. (4) and (5) are if the form 
t=0:2 = 2%, a = a. (6) 


Equation (4) forms a system of n linear equations for n+1 unknowns dz,/dt, 


i=1,...,n, da/dt, for each t. Suppose that the matrix 
( af, of, Of: of, ) 
oxy’ yer Oxy O2k4. es OFn41 
ee ee (7) 
Ox 
fn fn fn fn 
| on "Onn Atego’ dEn44 | 


is regular (for certain values of t and k, 1 < k < n+ 1). For clarity here, we have 


denoted 
Tn41 = a (8) 
Equation (4) can then be presolved with respect to the unknowns dz;/dt, ..., 
dxp—1/dt, dtp4:/dt,..., Atns1/dt, depending on dx,/dt in the form 
dx; dz, 
—=6;—, i=1,2,...,k—1, eee ae 9 
7 B 7H 1 2 k—-1,k+1 n+ (9) 


In the program the unknowns with a subscript k (dz;,/dt and x,) are called the 
independent variables. The value of the subscript k is determined in the Gaussian 
elimination procedure using controlled pivoting. The result depends on the values 
of PREF (I). 

On substituting (9) into (5) we obtain 


2 a4 —1 
(2) - (04 Bn) 0 
dt ime isk 


y = 1000, B = 22, 6 = Bo = 2, O04 = Oc2 = 0; Xo = (0;0;0;0), ao = 0, 

PREF(1) = (1,0.1, 1,1,0.02), HH = 0.02, EPS = 10“, MXADMS = 4, 

NCORR = 4, NCRAD = 0, NDIR(W) = (1,1,1,1,1). 

Calculated points on the curve z2(a) are numbered. For the points 1-12, 61-70, 114-140, 155-..., 
a was independent (k = 5); otherwise x. (k = 2) plays the role of an independent variable. 
Altogether 332 evaluations of the subroutine FCTN for calculation of 162 points was necessary. 
However, by choosing NCORR = 0 and NCRAD = 1, the number of evaluations of FCTN was 
lowered to 163, and in fact the same curve was obtained. 


The sign of dz,/dt is given by the orientation of the parameter t along the curve. 
All derivatives dz,/dt are then determined by (9). 

The Adams-Bashforth explicit multistep method with an automatic change in 
the order of approximation is used for the integration of differential equations (9) 
and (10). It is possible to use some other technique, e.g. the Runge-Kutta method. 
However, it seems that our technique is more suitable when considering the time- 
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INITAL = 


At most ITIN Newton iterations. If |\Axj <EPS is not 
fulfilled, -1 7+ ITIN and if INITAL = 1 then RETURN. 
If INITAL = 2 then always RETURN after initial Newton. 


Output 15%» Ot Vreg after each Newton iteration. 


x» 


Evaluation of f£ and 7 
Solution of linear system for evaluation of Newton 


increment Ax, k and coefficients 8, in (9) 
i 


if (NCORR # 0) warning 


x - Ax> x 
NC+1-+> NC 


x - Ax + x 


additional Newton correction 


Xd, V ne? ) 


4%, 90 97 ne? ) 


if (NCRAD = 0) output (x) 9+. 
if (NCRAD # 0) output (x 


ee 
dx, dx, 
Evaluation of ae and re according to (10) and (9), 


Integration over one step by Adams Bashforth method of 


highest (<4) ee eee order. 
lf rs curve" then -1~*> MAXOUT and RETURN. 
If values are out of bounds then -2 * MAXOUT and RETURN. 


Fig. 1. Schematic flowchart of method 


| 


consuming evaluation of the Jacobian matrix and the matrix inversion procedure 
in each step. 

In the course of integration the truncation error causes a deviation between the 
calculated solution x(¢) and the correct profiles x(t). The Newton method for 
variables x’ = (a1, Ya, ..., Ue-1, Loi, +--+, Un4i) 7 1s therefore used to improve the 
calculated profiles: 

L'new — v’oa = — r,'f. 
The higher accuracy of numerical integration lowers the computer time expenditure 
only because of the low number of Newton iterations. 

The algorithm is described by means of the schematic flow diagram given in 
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Fig. 2. The dependence z2(«) 


Figure 1. The specification of the individual dummy (formal) parameters of the 
subroutine DERPAR is given in the subroutine heading. 

The particular form of eq. (1) has to be programmed by the user as a subroutine 
FCTN. To illustrate the construction of the subroutine FCTN, an example is pre- 
sented for a set of four nonlinear equations: 


fx = a(1 — 23) exp (10x:/(1 + 10ai/y)) — 23 = 0 


fo = aB(1 — x3) exp (10a1/(1 + 10x1/y)) + 6191 — 10(1 + Bi)m = 0 
fs = 3 — 4% + a(l — a4) exp (10%2/(1 + 10a2/y)) = 0 
fs = 10x, — 10(1 + Be)te + aB(L — 24) exp (10a2/(1 + 1022/7)) + BAe = 0. 


Here y, B, 81, Be, 91, 92, and @ are physical parameters. The dependence 2x2(a) is 
shown in Figure 2. Generally speaking, it is always convenient to transform the 
unknowns 1, 22, ..., 2n, a SO that their values are of similar magnitude. 
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Applicability. This program can be used in the computation of the dependence 
of a solution on a parameter for sets of nonlinear equations, for nonlinear boundary 


value problems for ordinary differential equations [6, 7], for difference equations 
[8], ete. 
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ALGORITHM 
SUBROUTINE DERPAR(N, X, XLOW, XUPP, EPS, W, INITAL, ITIN, HH, DER 18 
* HMAX, PREF, NDIR, E, MXADMS, NCORRK, NCRAD, NOUT, OUT, DER 286 
* MAXOUT, NPRNT) DER 38 
DIMENSION X(11), XLOW(11), XUPP(11), W(11), HMAX(11), DER 49 
* PREF(11), NDIR(11), OUT(10@,12), F(11), G(18,11), BETA(1l), DER 58 
* MARK(11), DXDT(11) DER 690 
C OBTAINING OF DEPENDENCE OF SOLUTION X(ALFA) OF EQUATION DER 76 
CF (xX, ALFA) = 6 DER 890 
C ON PARAMETER ALFA BY MODIFIED METHOD OF DIFFERENTIATION DER 9@ 
C WITH RESPECT TO PARAMETER DER 180 
C N - NUMBER OF UNKNOWNS X(I) DER 116 
C X(1),...,X(N) - INITIAL VALUES OF X(I), AFTER RETURN FINAL VALUES DER 126 
Cc OF X(I) DER 139 
C X(N+1) - INITIAL VALUE OF PARAMETER ALFA, AFTER RETURN FINAL VALUE DER 146 
c OF ALFA DER 15@ 
C XLOW(1),...,XLOW(N) - LOWER BOUNDS FOR X(I) DER 160 
C XUPP(1),...,XUPP(N) - UPPER BOUNDS FOR X(I) DER 178 
C XLOW(N+1) ,XUPP(N+1) - LOWER AND UPPER BOUNDS FOR ALFA DER 180 
C IF XLOW OR XUPP IS EXCEEDED, THEN END OF DERPAR DER 190 
‘si AND MAXOUT=~2 AFTER RETURN DER 269 
C EPS - ACCURACY DESIRED IN NEWTON ITERATION FOR DER 216 
c SUM OF (W(I) *AbS(XNEW(I)-XOLD(I))), I=l,...,N+l DER 220 
C W(1),...,W(N+1) - WEIGHTS USED IN TERMINATION CRITERION OF NEWTON DER 230 
Cc PROCESS DER 248 
C INITAL - IF (INITAL.NE.@) THEN SEVERAL STEPS IN NEWTON ITERATION DER 250 
Cc ARE MADE BEFORE COMPUTATION IN ORDER TO INCREASE DER 260 
C ACCURACY OF INITIAL POINT- DER 278 
re IF (INITAL.EQ.1.AND.EPS-ACCURACY IS NOT FULFILLED IN ITIN DER 286 
Cc ITERATIONS) THEN RETURN. IF (INITAL.EQ.2) THEN ALWAYS RETURN DER 298 
C AFTER INITIAL NEWTON ITERATION, RESULTS ARE IN X. DER 308 
c IF (INITAL.EQ.3) THEN CONTINUE IN DERPAR AFTER INITIAL NEWTON. DER 318 
Cc IF (INITAL.EQ.@) THEN NO INITIAL NEWTON ITERATION IS USED. DER 320 
C ITIN - MAXIMAL NUMBER OF INITIAL NEWTON ITERATIONS. IF DER 330 
Cc EPS-ACCURACY IS NOT FULFILLED IN ITIN ITERATIONS THEN DER 348 
Cc ITIN=-1 AFTER RETURN. DER 350 
C HH - INTEGRATION STEP ALONG ARC LENGTH OF SOLUTION LOCUS DER 360 
C HMAX(1),...,HMAX(N+1) - UPPER BOUNDS FOR INCREMENTS OF X(I) IN DER 370 
Cc ONE INTEGRATION STEP (APPROXIMATION ONLY) DER 386 
C PREF(1),...,PREF(N+1) - PREFERENCE NUMBERS (EXPLANATION SEE IN DER 398 
Cc SUBR. GAUSE) DER 466 
C NDIR(1),...,NDIR(N+1) - INITIAL CHANGE OF X(1) IS POSITIVE ALONG DER 410 
c SOLUTION LOCUS (CURVE) IF NDIR(I)=1 AND NEGATIVE IF DER 420 
Cc NDIR(I)=-l. DER 430 
C E - CRITERION FOR TEST ON CLOSED CURVE, IF DER 448 
C (SUM OF (W(I) *ABS(X(I)-XINITIAL(I))),I=l,...,N+l).LE.E) DER 450 
iC THEN CLOSED CURVE MAY BE EXPECTED. DER 460 
C MXADMS - MAXIMAL ORDER OF ADAMS-BASHFORTH FORMULA, DER 479 
Cc 1.LE.MXADMS.LE.4. DER 489 


COLLECTED ALGORITHMS (cont.) 


BY ADAMS-BASHFORTH METHOD. 
WITHOUT NEW COMPUTATION OF JACOBIAN MATRIX IS USED. 
X(ALFA), NOUT.LE.MAXOUT. 


ON CURVE X(ALFA) 
OUT(J,N+2) - VALUE OF SQRT(SUM OF SQUARES OF F). 


USED (NCRAD.NE.®@). 


SQUARES OF F) IS ON OUR DISPOSAL ONLY. 


IF MAXOUT AFTER RETURN EQUALS TO- 
-l1 - THEN CLOSED CURVE X(ALFA) MAY BE EXPECTED 
-2 - THEN BOUND XLOW OR XUPP WAS EXCEEDED 


-LT. N. 


BOTH PRINTED AND IN ARRAY OUT. 

SUBROUTINE FCTN MUST BE PROGRAMMED IN FOLLOWING FORM - 
SUBROUTINE FCTN(N,X,F,G) 
DIMENSION X(11),F(18) ,G(1®,11) 


DATA INDIC, INDSP /1H*,1H / 
LW IS PRINTER DEVICE NUMBER 
Nl =N+1 
LW = 3 
IF (INITAL) 18, 60, 16 
C INITIAL NEWTON ITERATIONS 
1@ DO 48 L=1,ITIN 
CALL FCTN(N, X, F, G) 
SQUAR = 9.8 
DO 28 I=1,N 
SQUAR = SQUAR + F(I)**2 
290 CONTINUE 
LL =L-1 
SQUAR = SQRT(SQUAR) 
IF (NPRNT.NE.3) WRITE (LW,99999) LL, (X(I),I=1,N1), 
CALL GAUSE(N, G, F, M, 18, 11, PREF, BETA, K) 
IF (M.EQ.8@) GO TO 316 
P = @.8 
DO 38 J=1,N1 
X(J) = X(J) - P(d) 
P = P + ABS(F(J))*W(J) 
38 CONTINUE 
IF (P.LE.EPS) GO TO 58 
46 CONTINUE 
WRITE (LW,99998) ITIN 
ITIN = -1 
IF (INITAL.EQ.1) RETURN 
5@ IF (NPRNT.NE.3) WRITE (LW,99997) (X(I),I=1,N1) 
IF (INITAL.EQ.2) RETURN 
C AFTER INITIAL NEWTON ITERATIONS 
6@ IF (NPRNT.NE.3) WRITE (LW,99996) 


QD ANAAQANANAANINIANAAAGAIAIGAANNAAANANADKRAARRAANANROA 


KOUT = @ 

NOUT = @ 

MADMS = @ 

NC = 1] 

Kl = @ 

7@ CALL FCTN(N, X, F, G) 

SQUAR = 6.8 

DO 38 I=1,N 


SQUAR = SQUAR + F(I) **2 
88 CONTINUE 
CALL GAUSE(N, G, F, M, 18, 11, PREF, BETA, kK) 
IF (M.EQ.8) GO TO 318 
IF (K1.EQ.K) GO TO 98 
C CHANGE OF INDEPENDENT VARIABLE (ITS INDEX = K NOW) 
MADMS = @ 
Kl = K 
98 SQUAR = SQRT(SQUAR) 
IF (NCRAD.EQ.1) SQUAR = -~SQUAR 
P= 0.8 
DO 1808 I=1,N1 
P = P + W(I)*ABS(F(I)) 
188 CONTINUE 
IF (P.LE.EPS) GO TO 138 
IF (NC.GE.NCORR) GO TO 128 
DO 119 I=1,N1 
X(I) = X(I) - F(T) 
110 CONTINUE 
C ONE ITERATION IN NEWTON METHOD 


NCRAD - IF (NCRAD.NE.@) THEN ADDITIONAL NEWTON CORRECTION 


F(I)= FI (X(1),X(2),...,X(N) ,ALFA) FOR I=1,...,N 
G(I,J)= D FI (X(1),...,X(N) ,ALFA)/ D X(J) FOR I,J=1,... 
G(I,N+1)= D FI (X(1),...,X(N),ALFA)/ D ALFA FOR I=1,.. 
RETURN 

END 


NCORR - MAXIMAL NUMBER OF NEWTON CORRECTIONS AFTER PREDICTION 


NOUT - AFTER RETURN NUMBER OF CALCULATED POINTS ON THE CURVE 
OUT(J,1),OUT(J,2),...,OUT(J,N+1) - J-TH POINT X(1),...,X(N) ,-ALFA 
IF (OUT(J,N+2).LT.@.0) THEN ABS(OUT(J,N+2)) CORRESPONDS TO X 
AND ALFA NOT EXACTLY, BECAUSE ADDITIONAL NEWTON CORRECTION WAS 


VALUES F(I) ARE NOT COMPUTED FORK X AND ALFA PRINTED AND/OR 
STORED AND THEREFORE LAST TIME COMPUTED VALUE OF SQRT(SUM OF 


MAXOUT ~ MAXIMAL NUMBER OF CALCULATED POINTS ON CURVE X(ALFA). 


-3 - THEN SINGULAR JACOBIAN MATRIX OCCURRED, ITS RANK IS 


NPRNT - IF (NPRNT.EQ.3) THEN RESULTING POINTS ON CURVE X(ALFA) 
ARE IN ARRAY OUT( , ) AFTER RETURN. IF (NPRNT.EQ.1) THEN THESE 
POINTS ARE PRINTED ONLY. IF (NPRNT.EQ.2) THEN THESE POINTS ARE 


oN 


SQUAR 


726 
736 
748 
758 
7608 
778 
786 
798 
800 
816 
820 
$30 
8406 
856 
866 
8798 
886 
898 
988 
919 
926 
938 
949 
958 
968 
978 
988 
990 
1806 
1618 
1620 
1630 
10486 
1058 
1068 
1876 
1886 
1898 
1108 
1118 
1126 
1136 
1148 
1158 
1168 
1178 
1186 
1196 
1206 
1218 
1226 
1236 
1248 
1258 
1268 
1270 
1288 
1296 
1380 


1316 
1328 


1338 
1348 
1358 
1368 
1378 
1386 
1398 
1486 
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NC = NC + 1 
GO TO 78 
120 IF (NCORR.EQ.9) GO TO 138 
WRITE (LW,99995) NCORR, P 
136 NC = 1 
IF (NCRAD.EQ.@) GO TO 156 
C ADDITIONAL NEWTON CORRECTION 
DO 148 I=1,N1 
X(I) = X(I) - F(I) 
148 CONTINUE 
15g NOUT = NOUT + 1 
DO 166 I=1,N1 
MARK(I) = INDSP 
168 CONTINUE 
MARK(K) = INDIC 
IF (NPRNT.EQ.3) GO TO 178 
WRITE (LW,99994) 
WRITE (LW,99993) (X(I) ,MARK(I),I=1,N1), SQUAR 
170 IF (NPRNT.EQ.1) GO TO 2086 
IF (NOUT.LE.1@8) GO TO 186 
WRITE (LW,99992) 
RETURN 
186 DO 198 I=1,N1 


OUT(NOUT,I) = X(I) 
198 CONTINUE : 
OUT (NOUT,N+2) = SQUAR 
GO TO 219 


200 IF (NOUT.EQ.1) GO TO 180 
21@ IF (NOUT.GE.MAXOUT) RETURN 
DO 228 I=1,N1 
IF (X(1I).LT.XLOW(I) .OR. X(1I).GT.XUPP(I)) GO TO 398 
228 CONTINUE 
IF (NOUT.LE.3) GO TO 249 
P= 9.0 
DO 238 I=1,N1 
P = P + W(I)*ABS(X(I)-OUT(1,I)) 
238 CONTINUE 
IF (P.LE.E) GO TO 298 
C CLOSED CURVE MAY BE EXPECTED 
248 DXK2 = 1.6 
DO 258 I=1,N1 
DXK2 = DXK2 + BETA(TI) **2 
259 CONTINUE 
DXDT(K) = 1.6/SQRT(DXK2) *FLOAT (NDIR(K) ) 
C DERIVATIVE OF INDEPENDENT VARIABLE X(K) WITH RESPECT TO ARC LENGTH 
C OF SOLUTION LOCUS IS COMPUTED HERE 
H = HH 
DO 276 I=1,N1 
NDIR(I) = 1 
IF (I.EQ.K) GO TO 269 
DXDT(I) = BETA(I) *DXDT(K) 


268 IF (DXDT(I).LT.@.98) “NDIR(I) = -1l 
IF (H*ABS(DXDT(I)).LE.HMAX(I)) GO TO 278 
MADMS = @ 


H = HMAX(I)/ABS (DXDT (I) ) 
270 CONTINUE 
IF (NOUT.LE.KOUT+3) GO TO 280 
IF (H*ABS (DXDT(K)).LE.@.8*ABS(X(K)-OUT(1,K))) GO TO 289 
IF ((OUT(1,K)-X(K)) *FLOAT(NDIR(K)).LE.@.6) GO TO 288 
MADMS = @ 
IF (H*ABS(DXDT(K)).LE.ABS(X(K)-OUT(1,K))) GO TO 28¢ 
H = ABS (X(K)-OUT(1,K) )/ABS (DXDT (K) ) 
KOUT = NOU? 
28@ CALL ADAMS(N, DXDT, MADMS, H, X, MXADMS) 


GO TO 78 
296 WRITE (LW,99991) 
MAXOUT = -1 
RETURN 
366 MAXOUT = ~2 
RETURN 
318 WRITE (LW,9999@) (X(I),I=1,N1) 
MAXOUT = -3 
RETURN 


99999 FORMAT (3X, 7H DERPAR, 13, 25H.INITIAL NEWTON ITERATION/22X, 
* 11HX,ALFA,SQF=, 5F15.7/(33X, 5F15.7)) 

99998 FORMAT (/16H DERPAR OVERFLOW, I5, 2X, 18HINITIAL ITERATIONS/) 

99997 FORMAT (3X, 39H DERPAR AFTER INITIAL NEWTON ITERATIONS/22X, 
* 7HX,ALFA=, 4X, 5F15.7/(33X, 5F15.7)) 

99996 FORMAT (/6X, 45H DERPAR RESULTS (VARIABLE CHOSEN AS INDEPENDE, 
* 18HNT IS MARKED BY *)/) 

99995 FORMAT (/37H DERPAR NUMBER OF NEWTON CORRECTIONS=, 5, 
* 31H IS NOT SUFFICIENT,ERROR OF X=, F15.7/) 

99994 FORMAT (6X, 27H DERPAR RESULTS X,ALFA,SQF=) 

99993 FORMAT (33X, 5(F15.7, Al)) 

99992 FORMAT (/28H DERPAR OUTPUT ARRAY IS FULL//) 

99991 FORMAT (/36H DERPAR CLOSED CURVE MAY BE EXPECTED/) 

99994 FORMAT (/48H DERPAR SINGULAR JACOBIAN MATRIX FOR X AND ALFA=, 
* 5F12.6/(48X, 5F12.6)) 
END 


SUBROUTINE GAUSE(N, A, 8, M, NN, MM, PREF, BETA, K) 
DIMENSION A(NN,MM), B(MM), PREF(MM), BETA(MM), Y(11), X(11), 


DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 
DER 


GAU 
GAU 


14198 
1420 
1439 
1448 
1458 
1468 
14798 
14898 
1498 
1508 
1516 
15206 
1538 
1548 
1558 
1568 
1576 
1588 
1598 
1608 
1610 
1620 
16386 
1640 
1656 
1666 
1672 
1688 
1696 
17068 
1718 
1729 
1730 
1748 
17568 
1769 
1778 
1788 
1799 
18988 
1816 
1828 
1838 
1846 
1858 
1868 
18708 
1889 
1898 
1986 
1918 
19298 
1938 
1948 
1956 
1968 
1978 
1988 
19998 
2888 
2018 
2828 
2630 
2040 
2858 
2868 
2878 
2088 
2098 
2168 
2116 
2128 
2130 
2148 
2158 
2168 
2178 
2186 
2196 
2206 
2218 
2229 
2230 
2248 
2258 
2268 
2278 
2288 
2298 


18 
26 
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N - 
A - 
B - 


AAANAARAANANAANNA 


K - 


18 
28 


38 


49 


50 
66 


C THIS CONDITION FOR SINGULARITY OF MATRIX MUST BE SPECIFIED 
C MORE EXACTLY WITH RESPECT TO COMPUTER ACTUALLY USED 


78 


86 


96 


138 


118 
120 


136 


148 


156 


PREF (I) 
6.0. 


BETA (TI) 


* IRR(11), IRK(11) 
SOLUTION OF N LINEAR EQUATIONS FOR N+l UNKNOWNS 
BASED ON GAUSSIAN ELIMINATION WITH PIVOTING. 


NUMBER OF EQUATIONS 
N X (N+l1) MATRIX OF SYSTEM 
RIGHT-HAND SIDES 


X(I)=B(1I)+BETA(I) *X(K), 


M - IF (M.EQ.@) AFTER RETURN THEN RANK(A).LT.N 
- PREFERENCE NUMBER FOR X(I) TO BE INDEPENDENT VARIABLE, 
LE.PREF(I).LE.1.8, THE LOWER IS PREF(I) THE HIGHER IS 
PREFERENCE OF X(I). 
- COEFFICIENTS IN EXPLICIT DEPENDENCES OBTAINED IN FORM - 
I.NE.K. 


RESULTING INDEX OF INDEPENDENT VARIABLE 


Nl =N+#+1 
ID =] 
M= 1 
DO 1@ I=1,N1 
IRK(I) = @ 
IRR(I) = 6 
CONTINUE 
IR =1 
Is = 1 
AMAX = @.8 
DO 68 I=1,N 
IF (IRR(I)) 680, 38, 60 
DO 59 J=1,N1 
P = PREF (J) *ABS(A(I,J) ) 
IF (P-AMAX) 58, 58, 48 
IR =I 
Is = J 
AMAX = P 
CONTINUE 
CONTINUE 
IF (AMAX.NE.8.8) GO TO 78 


M= 6 
GO TO 158 
IRR(IR) = IS 


DO 98 I=1,N 


IF (I.EQ.IR .OR. A(I,1IS).EQ.8.8) GO TO 98 


P = A(I,1S)/A(IR,IS) 
DO 8@ J=1,Nl 
A(I,J) = A(I,J) - P*A(IR 
CONTINUE 
A(I,1IS) = 6.8 
B(I) = B(I) - P*B(IR) 
CONTINUE 
ID=ID+1 
IF (ID.LE.N) GO TO 20 
DO 10@ I=1,N 
IR = IRR(I) 
X(IR) = B(I)/A(1I,IR) 
IRK(IR) = 1 
CONTINUE 
DO 118 K=1,Nl 
IF (IRK(K).EQ.8) GO TO 120 
CONTINUE 
DO 130 I=]1,N 
IR = IRR(I) 
Y¥(IR) = -A(1I,K)/A(I,IR) 
CONTINUE 
DO 148 I=1,N1 
B(I) = X(I). 
BETA(I) = Y(I) 
CONTINUE 
B(K) = @.0 
BETA(K) = 6.98 
RETURN — 
END 


SUBROUTINE ADAMS(N, Db, MADMS 
DIMENSION DER(4,11), X(11), 


C ADAMS-BASHFORTH METHODS 


18 
26 


38 


40 


Nl =N+1 
DO 29 I=1,3 
DO 18 J=1,N1 
DER(I+1,J) = DER(I,J) 
CONTINUE 
CONTINUE 
MADMS = MADMS + 1 
IF (MADMS.GT.MXADMS) MADMS = 
IF (MADMS.GT.4) MADMS = 4 
DO 78 I=1,N1 
DER(1,I) = D(I) 


1d) 


Ld H, X, 
D(11) 


MXADMS 


GO TO (38, 40, 58, 68), MADMS 


X(I) = X(I) + H*DER(1,I) 
GO TO 78 


X(I) = X(I) + @.5*H*(3.0*DER(1,1I)-DER(2,1)) 


GO TO 78 


MXADMS ) 


GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 
GAU 


ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
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58 X(I) = X(I) + H*(23.0*DER(1,1I)-16.8*DER(2,1)+5.8*DER(3,I))/ 
* 12.0 
GO TO 78 
60 X(I) = X(I) + H*(55.6*DER(1,1)-59.8*DER(2,1)+37.0*DER(3,1) 
* -9.0*DER(4,1I))/24.@ 
78 CONTINUE 
RETURN 
END 


ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 
ADA 


268 
216 
228 
238 
248 
258 
2608 
276 
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ALGORITHM 503 


An Automatic Program for Fredholm Integral 
Equations of the Second Kind [D5] 


KENDALL ATKINSON 


University of lowa 


Key Words and Phrases: numerical analysis, linear integral equations, automatic 


algorithm, Nystrém method 
CR Categories: 5.18 
Language: Fortran 


DESCRIPTION 


The two algorithms given here, JESIMP and IEGAUS, are a complement of [1 ] 
where the theoretical development is described. 


REFERENCES 


1. Atxtnson, K. An automatic program for Fredholm integral equations of the second kind. 
ACM Trans. Math. Software 2, 2 (June 1976), 154-171. 


ALGORITHMS 
SUBROUTINE IESIMP(KERNEL, RHFCN, A, B, NZ, EPS, IFLAG, X, IES 19 
* NUPPER, MUPPER, W, IFLGR2, IER) IES 2 
C THE INTEGRAL EQUATION BEING SOLVED IS IES 30 
C B IES 4@ 
Cc X(S) - INT KERNEL(S,T)*X(T)*DT = RHFCN(S) IES 5¢ 
C A IES 60 
C THE METHOD BEING USED IS BASED ON THE NYSTROM METHOD WITH IES 7@ 
C SIMPSONS RULE, WITH AN ITERATIVE TECHNIQUE OF SOLUTION FOR THE IES 8@ 
C RESULTING LINEAR SYSTEM. IES 9@ 
C KERNEL THESE ARE DOUBLE PRECISION FUNCTIONS OF TWO AND ONE IES 16¢ 
C RHFCN VARIABLES, RESPECTIVELY. THEY MUST BE DECLARED IN AN IES 11 
C EXTERNAL STATEMENT IN THE PROGRAM CALLING IESIMP. IES 120 
C NZ THE INITIAL VALUE OF N IN THE PROGRAM. N IS THE ORDER IES 130 
Cc OF AN INVERSE MATRIX WHICH 1S BEING USED TO IES 140 
Cc ITERATIVELY SOLVE A LARGER SYSTEM OF ORDER M, WHICH IES 15¢ 
Cc APPROXIMATES THE ABOVE INTEGRAL EQUATION. THE CHOICE IES 16@ 
Cc OF NZ MUST ALWAYS BE ODD AND GREATER THAN TWO. FOR A IES 170 
Cc DEFAULT CHOICE, SET NZ=3. IES 18 
c ON COMPLETION OF THE PROGRAM, NZ-IS SET EQUAL TO THE IES 190 
Cc FINAL:NUMBER OF NODE POINTS USED IN OBTAINING THE IES 260 
Cc SOLUTION. THE ARRAYS W AND X WILL CONTAIN THE NZ IES 219 
Cc FINAL NODE POINTS AND CORRESPONDING SOLUTION IES 22¢ 
Cc VALUES. IES 230 
C EPS THE DESIRED ERROR, INTERPRETED ACCORDING TO IFLAG. IES 240 
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ANQAAARANAAARANRANDGDAAAAANAKNAANAARANNANADAANAADAAANAANAANAAAAANA 


aa 


aa AAQAANANAANANAANA 


Aaagqnaanannaraand 


IFLAG =@ 


NUPPER 


MUPPER 


IFLGR2 =@ 
=] 


THIS VARIABLE IS. CHANGED ON COMPLETION OF THE 
PROGRAM. SEE THE DISCUSSION OF IFLAG AND IER FOR MORE 
INFORMATION. 

EPS IS TO BE INTERPRETED AS AN ABSOLUTE ERROR. 

EPS IS TO BE INTERPRETED AS A RELATIVE ERROR. 

THE ANSWER TO THE INTEGRAL EQUATION, EVALUATED AT THE 
FINAL SET OF NODE POINTS, WHICH ARE STORED IN W. THE 
DIMENSION OF X SHOULD BE AT LEAST MUPPER. 

AN UPPER LIMIT ON THE VARIABLE N IN THIS PROGRAM. N 
IS THE ORDER OF APPROXIMATE INVERSE WHICH IS BEING 
USED TO ITERATIVELY SOLVE A LARGER SYSTEM OF ORDER M. 
AN UPPER LIMIT ON THE VARIABLE M IN THE PROGRAM. 

M IS THE NUMBER OF NODE POINTS BEING USED IN THE 
SIMPSON RULE APPROXIMATION OF THE INTEGRAL OPERATOR. 
N AND M ARE ALWAYS ODD INTEGERS, GREATER THAN TWO. 
THIS IS TEMPORARY WORKING STORAGE. IT SHOULD HAVE 
DIMENSION 4*NU*NU+16*NU+9*MU, WITH NU=NUPPER, 
MU=MUPPER. ON EXIT, W WILL CONTAIN THE FINAL CHOICE 
OF NODE POINTS,CORRESPONDING TO THE APPROXIMATE 
SOLUTION VALUES STORED IN X. 

THE NORMAL SETTING. 

IF THE INTEGRAND K(S,T)*X(T), REGARDED AS A FUNCTION 
OF T, IS KNOWN TO BE PERIODIC ALONG WITH A NUMBER OF 
ITS DERIVATIVES ON THE INTERVAL (A,B), FOR ALL S IN 
THE INTERVAL, THEN THE ERROR ESTIMATES WILL BE MORE 
ACCURATE IF IFLGR2=1. THIS WILL GENERALLY RESULT IN 
MORE RAPID CONVERGENCE OF THE PROGRAM. 

THIS ERROR COMPLETION CODE MEANS THAT THE ERROR TEST 
WAS SATISFIED. THE PREDICTED ERROR IS STORED IN EPS. 
THE ERROR TEST WAS NOT SATISFIED. THE PREDICTED ERROR 
IS IN EPS. 

THE ERROR TEST WAS NOT SATISFIED. THE VARIABLE EPS 
HAS BEEN SET TO ZERO. 

REGARDLESS OF THE VALUE OF IER, THE MOST ACCURATE 
SOLUTION OBTAINED IS STORED IN X. 


IESIMP IS PRESENTLY LIMITED TO NUPPER .LE. 160. THIS IS ENTIRELY 
DUE TO A RESTRICTION IN THE PROGRAM LINSYS. TO REMOVE THIS 
RESTRICTION, CHANGE THE DIMENSION STATEMENT IN THE 
COMMON/LINEAR/ STATEMENT IN LINSYS. 

DOUBLE PRECISION KERNEL, RHFCN, A, B, EPS, X, W, CUTOFF, 

* RATIO, ROOTRT 

DIMENSION X(1), W(1) 


EXTERNAL KERNEL, RHFCN 
KAKIRK KERR AKER RRR EIR RII IARI RER ERE RERERER 


COMMON /INFO/ Rl, R2, NFINAL 


* 


x 


THE VARIABLES IN COMMON/INFO/ GIVE ADDITIONAL INFORMATION ABOUT* 
THE FUNCTIONING OF IESIMP. Rl GIVES THE FINAL ITERATIVE RATE 
OF CONVERGENCE FOR SOLVING THE LINEAR SYSTEMS OF ORDER M. R2 
GIVES THE RATE OF CONVERGENCE OF THE NYSTROM METHOD. FOR A 
SMOOTH KERNEL FUNCTION AND SMOOTH SOLUTION FUNCTION X(S), THE 
VALUE OF R2 SHOULD BE $.@625 FOR SIMPSONS RULE. NFINAL GIVES 
THE FINAL VALUE OF N USED IN ITERATIVELY SOLVING THE LARGER 
SYSTEMS OF ORDER M. IF THE VALUE OF NFINAL EQUALS THE FINAL 
VALUE OF NZ, THEN ITERATION WAS NOT INVOKED SUCCESSFULLY. 


Se 


RRKEKRKKKEKKERERERKRERERERERKERERRKERERERKERERKRERERERERRERRRERRRRKKKKK 


DATA CUTOFF /@.5D@/ 
KKEKEKEKEKKERKRKRKRKKRRRRRREKRKKKRRREREKKRRRRRRRRKRREKRRERRRKRREKRKKRKKIEIE 


DATA RATIO /@.9625D6/, ROOTRT /@.25D@/ 


THESE CONSTANTS DEPEND ON THE NUMERICAL INTEGRATION RULE 
BEING USED. SEE THE DISCUSSION OF IESIMP IN ORDER TO SET THEM 
PROPERLY WHEN CHANGING NUMERICAL INTEGRATION RULES. RATIO 
DEPENDS ON THE RATE OF CONVERGENCE OF THE RULE BEING USED. 
ROOTRT USUALLY EQUALS SQRT(RATIO). 


k 


a 


KAKKKRERERREKRER RARER ERE RRR RRR EER ERIE RRR ER ERERER ERE RERERERKR 
SET UP RELATIVE BASE ADDRESSES FOR THE VARIOUS ARRAYS INTO WHICH 
W IS TO BE SPLIT. 
N = NUPPER 
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COLLECTED ALGORITHMS (cont.) 


C 


one) 


QNAaAaARAANAAANA 


aAaAaaAN 


Q 


M = MUPPER 

NSQ = NAN 

Il = 1 

12 = Il + NSQ 
13 = 12 + NSQ 
14 = 13 + (NSQHN)/2 
I5 = 14 + (NSQH) /2 
16 = I15+M 

17 = 16 +M 

I8 = 17 +N 

19 = I8 +N 

11g = 19 +M 
Ill = I1O +N 
112 = Ill +M 
113 = I12 + M 
114 = 113 + M 
115 = I14 +N 
Il6 = 115 +M 
117 = 116 + M 
118 = I17 +N 
119 = 118 +M 
12@ = 119 + 4*N 


NHALF = (N+1)/2 
CALL IESP(KERNEL, RHFCN, A, B, NZ, EPS, IFLAG, X, NUPPER, 


* MUPPER, IFLGR2, IER, RATIO, ROOTRT, CUTOFF, NHALF, W, W(11), 


* W(I2), W(13), W(I4), W(I5), W(I6), W(I7), W(18), W(I9), 
* W(I1O), W(I11), W(I12), W(I13), W(114), W(I15), W(1I16), 
* W(I17), W(I18), W(I19), W(12)) 

RETURN 

END 


SUBROUTINE IESP(KERNEL, RHFCN, A, B, NZ, EPS, IFLAG, X, NUP, 


* MUP, IFLGR2, IER, RATIO, ROOTRT, CUTOFF, NHALF, T, LUFACT, 
* KMM, KMN, KNM, RHS, R, RH, DELN, TM, TN, XM, XMZ, WM, WN, 
* OLDX, SAVE, XN, SAVE2, ASIDE, ASIDE3) 

THIS ROUTINE CONTROLS THE SOLUTION OF THE INTEGRAL EQUATION. 


DOUBLE PRECISION KERNEL, RHFCN, A, B, EPS, X, RATIO, ROOTRT, 
* CUTOFF, T, LUFACT, KMM, KMN, KNM, RHS, R, RH, DELN, TM, TN, 


* XM, XMZ, WM, WN, OLDX, SAVE, SAVE2, XN, ASIDE, ASIDE2, 


* ASIDE3, RZ, RIRAT, NUMR2, DENR2, NORM, DMIN1, DSQRT, ERROR, 


* TEMP, TEST, Rl, DENR1, NUMR1, RT, DET 

INTEGER OLDM, TWICE, FLAG 

DIMENSION X(MUP), T(MUP), LUFACT(NUP,NUP), KMM(NUP,NUP), 
* KMN(NUP,NHALF), KNM(NHALF,NUP), RHS(MUP), R(MUP), RH(NUP), 
* DELN(NUP), TM(MUP), TN(NUP), XM(MUP), XMZ(MUP), WM(MUP), 
* WN(NUP), OLDX(MUP), SAVE(MUP), XN(NUP), SAVE2(MUP), 
* ASIDE(NUP,4), ASIDE2(5), ASIDE3(NUP,NUP) 

COMMON /INFO/ R1, R2, N 

EXTERNAL KERNEL, RHFCN 


RHEKKERERKAERARERRRERRRERRERERERRERRERRRRRRERRR A RERERRERERREREREREREKI 


TWICE(KK) = 2*KK - 1 


* 


* 


THIS FUNCTION GIVES THE FORMULA FOR INCREASING THE NUMBER OF * 


NODE POINTS. WITH ANOTHER INTEGRATION RULE, IT MAY BE 
NECESSARY TO CHANGE THE DEFINITION OF TWICE(KK). 


* 
* 
* 


KAKAKKAKKKEKARKKEERRKER ERE RRR KARR RRR ARERR RARER 


INITIALIZATION. 

IER = @ 

LOOP = 1 

N = NZ 

R2 = @.5D@ 

M = TWICE(N) 

RLRAT = ROOTRT 
STAGE A. DIRECT SOLUTION OF LINEAR SYSTEM (I-KN)*XN=RHS, WHILE 
TRYING TO FIND A GOOD APPROXIMATE INVERSE TO IMPLEMENT THE 
ITERATIVE METHOD OF SOLUTION. 
CREATE NODES TN(IL) AND WEIGHTS WN(I), I=1,...,N. 

CALL WANDT(WN, TN, N, A, B) 
CREATE SYSTEM (I-KN)*XN=RHFCN. 
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COLLECTED ALGORITHMS (cont.) 


C 
Cc 


aa 


a aagaNgaaNgaAaana aaaAana 


a 


ana 


a 


DO 2@ I=1,N 
DO 1@ J=1,N 
LUFACT(I,J) = -WN(J)*KERNEL(TN(L) ,TN(J)) 
16 CONTINUE 
XN(I) = RHFCN(TN(I)) 
LUFACT(I,I) = LUFACT(I,I) + 1.@D¢ 
2@ CONTINUE 
GO TO 6¢@ 
THIS IS ENTRANCE FOR AN INCREASED VALUE OF N, USING PREVIOUSLY 
STORED VALUES IN KMM AND RHS. 
3@ DO 5@ J=1,N 
DO 4¢ I=1,N 
LUFACT(1I,J) = -KMM(I,J) 
46 CONTINUE 
WN(J) = WM(J) 
IN(J) = TM(J) 
XN(J) = RHS(J) 
LUFACT(J,J) = LUFACT(J,J) + 1.0D@ 
5@ CONTINUE 
THIS IS THE ENTRANCE WHEN ITERATION IN STAGE B FAILS AND WE NEED 
TO INCREASE N TO OBTAIN A BETTER ITERATIVE RATE. 
60 CONTINUE 
SOLVE (I-KN)*XN=RHFCN AT ALL TN(I).ALSO OBTAIN THE LU 
DECOMPOSITION FOR LATER USE IN THE STAGE B ITERATIVE METHOD. 
RRERKEKRKEERRERRERERKRKRKEREREREREERRRERRRRKRERERRRRRERRERRREKRKERKRKRRIRKEE 
* 
CALL LINSYS(LUFACT, LUFACT, N, XN, XN, 1, DET, NUP) 
* 
THIS LINEAR EQUATION SOLVER MAY BE REPLACED BY ANOTHER PROGRAM,* 
BUT CARE MUST BE TAKEN THAT THE NEW PROGRAM DOES THE SAME JOB * 
AS LINSYS. THE PROGRAM LINSYS IS ALSO REFERENCED IN THE * 


SUBROUTINE ITERT. * 
* 


REREEKEKEKRKERRKRRERKERERREKERERERRERKRRERRERERRERREERERREREREREREREEREE 


IF (LOOP.EQ.1) GO TO 11¢@ 
IF (LOOP.EQ.2) GO TO 8¢ 
COMPUTE THE RATE OF CONVERGENCE, AND COMPARE WITH THE 
THEORTICAL RATIO. 
NUMR2 = NORM(XN,OLDX,N,1) 
R2 = DMIN1(@.5D@,NUMR2/DENR2) 
IF ((R2.LT.RATIO) .AND. (IFLGR2.EQ.@)) R2 = RATIO 
RLRAT = DMIN1(DSQRT(R2) ,ROOTRT) 
IF (IFLGR2.EQ.0) RIRAT = ROOTRT 
CHECK FOR ERROR IN XN USING TEST INVOLVING R2 AND OLDX,ACCORDING 
TO THEORY FOR ASYMPTOTIC ERROR BOUNDS. 
7@ ERROR = (R2/(1.@D@-R2) )*NUMR2 
IF (IFLAG.EQ.1) ERROR = ERROR/NORM(XN,XN,N,@) 
IF ((IFLGR2.EQ.1) .AND. (R2.LT.RATIO)) ERROR = 2.@*ERROR 
IF (ERROR.LE.EPS) GO TO 9¢ 
DENR2 = NUMR2 
GO TO 11¢ 
ENTRANCE FOR LOOP=2. 
8@ NUMR2 = NORM(XN,OLDX,N, 1) 
DENR2 = %.@D@ 
GO TO 7¢ 
SET UP T,X,EPS,NZ FOR SUCCESSFUL RETURN. 
9 DO 10@ I=1,N 
X(1) = XN(1) 
T(1) = TN(1) 
16@ CONTINUE 
EPS = ERROR 
NZ = N 
RETURN 
INITIALIZE FOR SOLVING (I-KM)*XM=RHFCN ITERATIVELY. 
116 CALL WANDT(WM, TM, M, A, B) 
FLAG = @ 
CALL INTERP(TM, WM, XMZ, M, TN, WN, XN, N, KERNEL, RHFCN, 
* RHS, KMN, NHALF, NUP) 
DO 12@ I=1,M 
OLDX(1) = XMZ(I) 
120 CONTINUE 
CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 
* KMN, KNM, RHS, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
DENR1 = NORM(XM,XMZ,M,1) 
FLAG = 1 
DO 13¢ I=1,M 
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aa 


XMZ(I) = XM(I) 
13@ CONTINUE 
CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 
* KMN, KNM, RHS, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
NUMR1 = NORM(XM,XMZ,M,1) 
CHECK ON THE SPEED OF CONVERGENCE OF ITERATIVE METHOD. IF IT IS 
SUFFICIENTLY RAPID, THEN FIX N AND GO TO STAGE B. 
Rl = NUMR1/DENR1 
IF (M.GT.NUP) GO TO 19¢ 
IF (R1.LE.RIRAT) GO TO 15¢ 
REINITIALIZE FOR SOLVING (I-KN)*XN=RHFCN AGAIN WITH A LARGER N. 
149 N=M 
LOOP = LOOP + 1 
M = TWICE(N) 
GO TO 3¢ 
SAVE INFORMATION IN CASE STAGE B ABORTS AT A LARGER VALUE OF M 
AND STAGE A HAS TO BE RETURNED TO. 
15@ DO 16¢ I=1,M 


ASIDE(I,1) = OLDX(I) 
ASIDE(I,2) = WM(I) 
ASIDE(I,3) = TM(I) 
ASIDE(I,4) = RHS(I) 
16@ CONTINUE 
ASIDE2(1) = LOOP 
ASIDE2(2) = M 
ASIDE2(3) = R2 
ASIDE2(4) = DENR2 
ASIDE2(5) = RIRAT 


DO 18¢ I=1,M 
DO 176 J=1,M 
ASIDE3(1I,J) = KMM(I,J) 


170 CONTINUE 


18@ CONTINUE 
GO TO 24¢ 
STAGE B. ITERATIVE METHOD OF SOLUTION OF (1I-KM)*XM=RHS. 
199 IF (R1L.LE.CUTOFF) GO TO 24@ 
IF ITERATES ARE CONVERGING VERY SLOWLY OR NOT AT ALL, THEN 
RETURN WITHOUT FURTHER ATTEMPTS TO LESSEN ERROR. 
20@ IF (LOOP.NE.1) GO TO 23¢ 
EPS = 9.OD0 
IER = 2 
210 DO 220 I=1,N 
X(I) = XN(I) 
T(L) = TN(I) 
220 CONTINUE 
NZ =N 
RETURN 
236 EPS = ERROR 
IER = 1 
GO TO 216 
TEST TO SEE IF THE CURRENT ITERATE XM IS SUFFICIENTLY ACCURATE 
COMPARED TO THE TRUE XM. 
240 TEMP = NORM(XM,OLDX,M,1) 
RT = DMIN1(RATIO,R2) 
TEST = ((1.@D0-R1)/R1)*(RT/(1.@DQ@-RT) )* TEMP 
IF (NUMRL.LE.TEST) GO TO 320 
ITERATE NOT ACCURATE. INITIALIZE FOR COMPUTATION OF ANOTHER 
ITERATE. 
DENR1 = NUMR1 
DO 25¢@ I=1,M 
XMZ(1) = XM(I) 
25@ CONTINUE 
CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 
* KMN, KNM, RHS, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
NUMR1 = NORM(XM,XMZ,M,1) 
Rl = NUMR1/DENR1 
IF (RL.LE.CUTOFF) GO TO 24¢ 
THIS IS ENTRANCE FOR CASE WHERE ITERATION FAILS IN STAGE B. 
PARAMETERS MUST BE RESET FOR A RETURN TO STAGE A, OR IF N CANNOT 
BE INCREASED, FOR AN ERROR EXIT FROM IESIMP. 
260 MNEW = ASIDE2(2) 
IF (MNEW.GT.NUP) GO TO 290 
IF (M.EQ.TWICE(N)) GO TO 14¢ 
N = MNEW 
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1496 
1500 
151¢ 
1520 
1530 
154@ 
155@ 
156@ 
1570 
158@ 
159¢ 
160¢ 
1610 
162¢ 
163¢ 
164¢ 
165@ 
166¢@ 
1670 
168@ 
1690 
1700 
171¢ 
172@ 
1730 
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175@ 
1760 
177 
1780 
179¢ 
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1810 
1826 
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185¢ 
186¢ 
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189@ 
190¢ 
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192¢ 
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LUFACT(1,J) = -ASIDE3(1,J) 
270 CONTINUE 
OLDX(J) = ASIDE(J,1) 
WN(J) = ASIDE(J,2) 
TN(J) = ASIDE(J, 3) 
XN(J) = ASIDE(J,4) 
LUFACT(J,J) = LUFACT(J,J) + 1.@D@ 
28@ CONTINUE 
M = TWICE(N) 
LOOP = ASIDE2(1) + 1.@D¢@ 
R2 = ASIDE2(3) 
DENR2 = ASIDE2(4) 
RIRAT = ASIDE2(5) 
GO TO 6¢ 
ABORTIVE EXIT FROM STAGE B. N CANNOT BE INCREASED FURTHER, AND 
Rl IS NOT SUFFICIENTLY SMALL. 
290 IF (M.EQ.TWICE(N)) GO TO 20¢ 
DO 30@ I=1,OLDM 
T(L) = SAVE(I) 
30@ CONTINUE 
NZ = OLDM 
IF (LOOP.EQ.1) GO TO 31¢@ 
EPS = ERROR 
IER = 1 
RETURN 
319 EPS = @.0@ 
IER = 2 
RETURN 
AN ACCURATE VALUE OF XM HAS BEEN OBTAINED. R2 1S TO BE COMPUTED 
AND COMPARED TO RATIO. THEN THE ERROR IN XM IS TO BE ESTIMATED. 
320 IF (LOOP.EQ.1) GO TO 340 
NUMR2 = TEMP 
R2 = DMINI1 (NUMR2/DENR2,@.5D@) 
IF ((R2.LT.RATIO) .AND. (IFLGR2.EQ.@)) R2 = RATIO 
DENR2 = NUMR2 
33@ ERROR = (R2/(1.@D@-R2) ) *TEMP 
IF (IFLAG.EQ.1) ERROR = ERROR/NORM(XM,XM,M,@) 
IF ((IFLGR2.EQ.1) .AND. (R2.LT.RATIO)) ERROR = 2.Q@*ERROR 
IF (ERROR.LE.EPS) GO TO 46¢ 
MNEW = TWICE(M) 
IF (MNEW.LE.MUP) GO TO 35¢@ 
IER = 1 
GO TO 44¢ 
34@ DENR2 = TEMP 
LOOP = 2 
GO TO 33¢ 


C ERROR NOT SUFFICIENTLY SMALL. M IS INCREASED AND TWO MORE 


C 


ITERATES ARE COMPUTED WITH A NEW M. 
350 DO 360 I=1,M 
X(1) = XM(I) 
360 CONTINUE 
OLDM = M 
M = MNEW 
DO 37@ I=1,OLDM 
SAVE2(1) = WM(1) 
SAVE(L) = TM(1) 
37@ CONTINUE 
CALL WANDT(WM, TM, M, A, B) 
FLAG = @ 
CALL INTERP(TM, WM, XMZ, M, SAVE, SAVE2, XM, OLDM, KERNEL, 
* RHFCN, RHS, KMN, NHALF, NUP) 
DO 380 I=1,M 
OLDX(I) = XMZ(1) 
38@ CONTINUE 


CALL LTERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 


* KMN, KNM, RHS, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
DENR1 = NORM(XM, XMZ,M, 1) 
FLAG = 1 
DO 39¢ I=1,M 
XMZ(1I) = XM(I) 
390 CONTINUE 


CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 


* KMN, KNM, RHS, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
NUMR1 = NORM(XM,XMZ,M,1) 

Rl = NUMRI/DENRI 

IF (RL.LE.CUTOFF) GO TO 24@ 
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GO TO 26¢ 
400 DO 416 I=1,M 
X(I) = XM(I) 
T(I) = TM(I) 
416 CONTINUE 
NZ = M 
EPS = ERROR 
RETURN 
END 


SUBROUTINE WANDT(W, T, N, A, B) 
C THIS ROUTINE CALCULATES THE WEIGHTS AND NODE POINTS FOR 
C SIMPSONS RULE ON (A,B), WITH N EVENLY SPACED NODES. 
DOUBLE PRECISION W, T, A, B, FN, FI, TEMP, H 
DIMENSION W(N), T(N) 
C CALCULATE NODE POINTS. 
FN = N 
H = (B-A)/(FN-1.@D0) 
DO 1@ I=1,N 
FIL = 1 
T(1) = A + (FI-1.@D@)*H 
1@ CONTINUE 
C CALCULATE WEIGHTS. 
W(1) = H/3.OD¢ 


W(N) H/3.@D@ 
NM1 = N - l 
TEMP = 4.Q@D@*H/3.0D@ 


DO 24 I=2,NM1,2 
W(L) = TEMP 
20 CONTINUE 
IF (N.EQ.3) RETURN 
TEMP = 2.Q@D@*H/3.@D@ 


NM2 = N - 2 
DO 3@ I=3,NM2,2 
W(L) = TEMP 
30 CONTINUE 
RETURN 
END 


SUBROUTINE INTERP(TM, WM, XM, M, TN, WN, XN, N, KERNEL, 
* RHFCN, RHS, KMN, NHALF, NUP) 
C USE THE VALUES OF XN(I), I=1,...,N, TO CALGULATE THE NYSTROM 
C INTERPOLATES XM(I), I=1,...,M. 
DOUBLE PRECISION KERNEL, RHFCN, TM, WM, XM, TN, WN, XN, RHS, 
* KMN 
DIMENSION TM(M), WM(M), XM(M), TN(N), WN(N), XN(N), RHS(M), 
* KMN (NUP , NHALF) 
IF (M.GT.NUP) GO TO 66 
C SINCE M .LE. NUPPER, SAVE K(TM(1L),TN(J))=KMN(I,J) AND 
C RHS(1)=RHFCN(TM(I)) FOR LATER USE IN ITERT. 
DO 26 I=1,M 
DO 1¢ J=1,N 
KMN(1I,J) = WN(J)*KERNEL(TM(1) ,TN(J)) 
16 CONTINUE 
2@ CONTINUE 
DO 3¢ I=1,M 
RHS(1I) = RHFCN(TM(1)) 
XM(I) = RHS(I) 
3@ CONTINUE 
C CALCULATE NYSTROM INTERPOLATING FORMULA. 
DO 5@ I=1,M 
DO 4@ J=1,N 
XM(I) = XM(I) + KMN(I,J)*XN(J) 
4@ CONTINUE 
5@ CONTINUE 
RETURN 
C M .GT. NUPPER, SO SAVE JUST RHS(I) FOR LATER USE IN ITERT. 
C CALCULATE NYSTROM INTERPOLATING FORMULA. 
60 DO 8¢@ I=1,M 
RHS (I) = RHFCN(TM(I)) 
XM(I) = RHS(I) 
DO 7¢ J=1,N 
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XM(L) = XM(I) + WN(J)*KERNEL(TM(I) ,TN(J))*XN(J) 
7@ CONTINUE 
8@ CONTINUE 
RETURN 
END 


SUBROUTINE ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, 
* XMZ, KMM, KMN, KNM, RHS, LUFACT, R, RH, DELN, NUP, NHALF, 
* IFLG) 
THIS ROUTINE CALCULATES ONE ITERATE XM GIVEN THE INITIAL GUESS 
XMZ. THE ROUTINE IS DIVIDED ACCORDING TO WHETHER OR NOT 
M .GT. NUPPER. 


DOUBLE PRECISION KERNEL, RHFCN, TN, WN, TM, WM, XM, XMZ, KMM, 


* KMN, KNM, RHS, LUFACT, R, RH, DELN, SUM, DET 
DIMENSION TN(N), WN(N), TM(M), WM(M), XM(M), XMZ(M), 
* KMM(NUP,NUP), KMN(NUP,NHALF), KNM(NHALF,NUP), RHS(M), 
* LUFACT(NUP,NUP), R(M), RH(N), DELN(N) 
M .GT. NUPPER MEANS THAT THE MATRICES KMM,KMN,KNM CAN NO LONGER 
BE STORED DUE TO LACK OF SPACE. 
IF (M.GT.NUP) GO TO 12¢@ 
IF (IFLG.EQ.1) GO TO 4¢ 
IF IFLG=6, THEN THE MATRICES KMM AND KNM MUST BE COMPUTED 
AND STORED. 
DO 3@ J=1,M 
DO 1¢ I=1,M 
KMM(I,J) = WM(J)*KERNEL(TM(I) ,TM(J)) 
16 CONTINUE 
DO 2¢ I=1,N 
KNM(I,J) = WM(J)*KERNEL(TN(I),TM(J)) 
2¢ CONTINUE 
3@ CONTINUE 
COMPUTE RESIDUALS R(1)=RHFCN(TM(1) )-XMZ(1I)+KM(TM(1) )*XMZz (I) 
4@ DO 6@ I=1,M 
SUM = 9.@D@ 
DO 5¢@ J=1,M 
SUM = SUM + KMM(I,J)*XMZ(J) 
50 CONTINUE 
R(I) = RHS(I) - (XMZ(I)-SUM) 
60 CONTINUE 
COMPUTE RH=KM*R AT ALL TN(I). 
DO 8@ I=1,N 
RH(I) = @.0D0 
DO 7@ J=1,M 
RH(I) = RH(1) + KNM(I,J)*R(J) 
70 CONTINUE 
8¢ CONTINUE 
CALCULATE DELN=((I-KN)**(-1))*KM*R AT ALL TN(I). 


RKAKEKKKRKEKREKKEKRKERERERERRRKERER RRR ERRERERERRRRRERERERRRRERERERKEKEKEE 


CALL LINSYS(LUFACT, LUFACT, N, RH, DELN, 3, DET, NUP) 


SEE THE ORIGINAL REFERENCE IN IESP. 


RKRKKEREKRKERERKKRRKKEERKERRRERRRERK ERR RERRRERRKRREKERRKRERKERKERRKRKRRKKKKR 


CALCULATE NEW XM. 
DO 11¢ I=1,M 
SUM = 9.@D0 
DO 96 J=1,M 
SUM = SUM + KMM(1L,J)*R(J) 
99 CONTINUE 
DO 16@ J=1,N 
SUM = SUM + KMN(I,J)*DELN(J) 
166 CONTINUE 
XM(I) = SUM + R(1) + XMZ(I) 
110 CONTINUE 
RETURN 
ENTRANCE WHEN M .GT. NUP. 
CALCULATE RESIDUALS. 
129 DO 14¢ I=1,M 
SUM = @.@D@ 
DO 13¢ J=1,M 
SUM = SUM + WM(J)*KERNEL(TM(1) ,TM(J) )*XMZ (J) 
136 CONTINUE 
R(I) = RHS(I) - (XMZ(1)-SUM) 


INT 
INT 
INT 
INT 
INT 


ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 


ITE 


ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 
ITE 


503-P 8- 


0 


COLLECTED ALGORITHMS (cont.) 


aa 


agqagAaAN 


NANDANQAAANMDANDAANANANANAANRAANANANA 


14@ CONTINUE 
CALCULATE RH=KM*R. 
DO 16@ I=1,N 
RH(I) = 9.@D¢@ 
DO 15@ J=1,M 
RH(I) = RH(L) + WM(J)*KERNEL(TN(I) ,TM(J))*R(J) 

15@ CONTINUE 
16@ CONTINUE 


KKKKKEKKKRKREKERKRERERERERERERERRERRRRRRRERRERERERRRRERERERERREERERERKK 


CALL LINSYS(LUFACT, LUFACT, N, RH, DELN, 3, DET, NUP) 


SEE THE ORIGINAL REFERENCE IN IESP. 


RKKKAKKKKKAKRKAKEK KERR ERKERERRRRRERRRERERERE RRR RERRRAERERERERERERERER 


CALCULATE XM. 
DO 19¢ I=1,M 
SUM = @.0D¢ 
DO 17¢ J=1,M 
SUM = SUM + WM(J)*KERNEL(TM(I) ,TM(J) )*R(J) 
17@ CONTINUE 
DO 18¢ J=1,N 
SUM = SUM + WN(J)*KERNEL(TM(I) ,TN(J))*DELN(J) 
189 CONTINUE 
XM(1) = SUM + R(I) + XMZ(I) 
19@ CONTINUE 
RETURN 
END 


DOUBLE PRECISION FUNCTION NORM(X, Y, N, IFLAG) 
IFLAG=@ CALCULATE THE MAXIMUM NORM OF X. 
IFLAG=1 CALCULATE THE MAXIMUM NORM OF X-Y. 

DOUBLE PRECISION X, Y, DMAX1, DABS 

DIMENSION X(N), Y(N) 

IF (IFLAG.EQ.1) GO TO 20 
FIND THE NORM OF X. 

NORM = @.0D@ 

DO 1¢ I=1,N ‘ 

NORM = DMAX1 (NORM,DABS (X(I))) 
1@ CONTINUE 
RETURN 
FIND THE NORM OF X-Y. 
20 NORM = @.@D@ 
DO 3@ I=1,N 
NORM = DMAX1 (NORM,DABS(X(1I)-Y(I))) 
36 CONTINUE 
RETURN 
END 


SUBROUTINE LINSYS(A, D, N, B, X, OPTION, DET, MACHIN) 

SOLVE A*X=B, ORDER(A)=N, DIMENSION OF A=MACHIN. 

OPTION=1 SOLVE A*X=B, LEAVE THE LU DECOMPOSITION A=L*U IN D 
AND THE PIVOTS IN PIVOT. THE ANSWERS ARE LEFT IN X. 
IT IS PERMISSABLE TO LET B=X AND D=A, BUT THEN THE 
ORIGINAL CONTENTS OF A AND B ARE LOST. 

OPTION=2 CALCULATE DECOMPOSITION A=L*U INCLUDING PIVOTS. SOLVE 
A*X=B, AND THEN CALCULATE THE RESIDUAL AND ONE 
CORRECTION. THE CORRECTIONS ARE LEFT IN R, THE NEW 
VALUE OF Xl IN X, THE RELATIVE ERROR 

NORM (X@~X1) /NORM(X1) 
IN THE VARIABLE ERROR, AND THE RELATIVE RESIDUAL 
NORM (RESIDUAL) /NORM(B) 
IN THE VARIABLE RELRSD. THESE VALUES CAN BE OBTAINED 
USING THE COMMON/LINEAR/ GIVEN BELOW. 

OPTION=3 SAME AS OPTION=1, EXCEPT A=L*U IS KNOWN AND STORED 
IN D. 

OPTION=4 SAME AS OPTION=2, EXCEPT A=L*U IS KNOWN AND STORED 
IN D. 

THE DECOMPOSITION OF A INTO L*U USES SCALED PARTIAL PIVOTING IN 

THE COLUMNS. FOR OPTIONS 1 AND 2, THE DETERMINANT OF A IS 

CALCULATED AND STORED IN DET. IF DET=@, THEN THE ANSWERS ARE 

NONSENSE, D AND X DO NOT CONTAIN USEFUL INFORMATION, AND AND A 
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C AND B ARE LEFT UNDISTURBED (UNLESS D=A OR X=B). LIN 240 
C LINSYS IS PRESENTLY LIMITED TO N .LE. 16@. TO REMOVE THIS LIN 250 
C RESTRICTION,CHANGE THE DIMENSION STATEMENT FOR THE ARRAYS R, LIN 260 
C SCALE, AND PIVOT, WHICH ARE GIVEN IN COMMON/LINEAR/. LIN 270 
INTEGER OPTION, PIVOT LIN 289 
DOUBLE PRECISION NORMX, NORME, NORMB, NORMR, A, D, B, X, R, LIN 290 

* SCALE, ERROR, RELRSD, DET, C, TEMP, DMAX1, DABS, SUM LIN 36¢ 
DIMENSION A(MACHIN,MACHIN), D(MACHIN,MACHIN), B(N), X(N) LIN 310 
COMMON /LINEAR/ R(10@), SCALE(16@), ERROR, RELRSD, PIVOT(1¢@) LIN 320 

ISWIT = 1 LIN 330 

IF (OPTION.GT.2) GO TO 11¢ LIN 34¢ 

C PRODUCE LU DECOMPOSITION OF A AND DET(A) LIN 350 
DET = $.@D@ LIN 360 

DO 2¢ I=1,N LIN 370 

DO 1@ J=1,N LIN 380 

D(I,J) = A(I,J) LIN 390 

16 CONTINUE LIN 46¢ 

2@ CONTINUE LIN 416 

C PRODUCE SCALING FACTORS FOR SCALED PARTIAL PIVOTING. LIN 420 
DO 4@ I=1,N LIN 430 
SCALE(I) = @.@D@ LIN 44@ 

DO 3¢ J=1,N LIN 45@ 
SCALE(I) = DMAX1(SCALE(I) ,DABS(D(I,J))) LIN 460 

3@ CONTINUE LIN 470 

IF (SCALE(I) .EQ.@.@D@) RETURN LIN 480 

4@ CONTINUE LIN 490 
DET = 1.@D¢ LIN 56 

NM1 =N- 1 LIN 51@ 

C BEGIN GAUSSIAN ELIMINATION. LIN 52@ 
DO 1¢@ K=1,NM1 LIN 530 

C SELECT PIVOT ROW. LIN 54@ 
C = DABS(D(K,K))/SCALE(K) LIN 550 

INDEX = K LIN 56@ 

KPl1 =K+1 LIN 576 

DO 5@ I=KP1,N LIN 580 

TEMP = DABS (D(I,K))/SCALE(I) LIN 59¢ 

IF (TEMP.LE.C) GO TO 50 LIN 640 

INDEX = I LIN 619 

C = TEMP LIN 620 

5@ CONTINUE LIN 63¢@ 
PIVOT(K) = INDEX LIN 64 

IF (INDEX.EQ.K) GO TO 70 LIN 659 

C SWITCH ROWS OF D. LIN 660 
DO 6@ J=K,N LIN 670 

TEMP = D(K,J) LIN 680 

D(K,J) = D(INDEX,J) LIN 696 
D(INDEX,J) = TEMP LIN 700 

60 CONTINUE LIN 71¢ 
TEMP = SCALE(K) LIN 72 
SCALE(K) = SCALE (INDEX) LIN 730 
SCALE(INDEX) = TEMP LIN 740 

DET = -DET LIN 75@ 

7@ DET = DET*D(K,K) LIN 760 

C ELIMINATE UNKNOWN =K FROM BELOW DIAGONAL IN COLUMN kK. LIN 770 
IF (DET.EQ.@.@D@) RETURN LIN 78 

DO 9¢ I=KP1,N LIN 790 

D(I,K) = D(I,K)/D(K,K) LIN 8@@ 

TEMP = D(I,K) LIN 810 

DO 8@ J=KP1,N LIN 82 

D(I,J) = D(I,J) - TEMP*D(K,J) LIN 83 

80 CONTINUE LIN 840 

96 CONTINUE LIN 850 
10@ CONTINUE LIN 860 
DET = DET*D(N,N) LIN 870 

IF (DET.EQ.@.@D@) RETURN LIN 880 

C THE DECOMPOSITION A=P*L*U IS COMPLETE. LIN 899 
C BEGIN SOLUTION OF LINEAR SYSTEM P*L*U*X=B LIN 90@ 
C SET R AND X FOR SOLUTION OF A*X=B. LIN 910 
116 DO 12@ I=1,N LIN 92¢ 
R(L) = BCI) LIN 930 

X(1) = @.@D@ LIN 940 

12@ CONTINUE LIN 95@ 
GO TO 17¢ LIN 96¢ 

C SET R=B-A*X FOR COMPUTATION OF CORRECTION. LIN 97¢ 
13@ DO 15@ I=1,N LIN 980 


SUM = 0.@D¢ LIN 990 
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DO 14@ J=1,N LIN 1000 

SUM = SUM + A(I,J)*X(J) LIN 1¢1¢@ 

146 CONTINUE LIN 1626 
R(I) = BCI) - SUM LIN 103¢ 

15@ CONTINUE LIN 104@ 
NORMB = 9%. @D@ LIN 1065¢ 

NORMR = @.@D¢@ LIN 1660 

DO 16@ I=1,N LIN 1070 

NORMB = DMAX1(NORMB,DABS(B(I))) LIN 168¢ 

NORMR = DMAX1(NORMR,DABS (R(I))) LIN 1690 

16@ CONTINUE LIN 1100 
RELRSD = NORMR/NORMB LIN 111 

ISWIT = 2 LIN 1126 

C SOLVE P*L*Z=R AND STORE IN R. LIN 113¢ 
17@ NM1 = N - 1 LIN 114¢ 
DO 2¢¢ K=1,NM1 LIN 115¢ 

IF (PIVOT(K) .EQ.K) GO TO 18¢ LIN 1160 

KPIV = PIVOT(K) LIN 1170 

TEMP = R(K) LIN 118¢ 

R(K) = R(KPIV) LIN 119% 

R(KPIV) = TEMP LIN 12¢¢ 

18@ KPI1=K+41 LIN 121¢ 
DO 19% I=KP1,N LIN 122¢ 

R(I) = R(I) - D(I,K)*R(K) LIN 1230 

199 CONTINUE LIN 12406 
290¢@ CONTINUE LIN 125@ 

C SOLVE U*E=R AND STORE IN R. ALSO LET X=X+E. LIN 1260 
R(N) = R(N)/D(N,N) LIN 127¢ 

GO TO (216, 22@, 216, 22), OPTION LIN 128¢ 

219 X(N) = R(N) LIN 1290 
GO TO 23¢ LIN 1340 

22@ X(N) = X(N) + R(N) LIN 1310 
236 DO 276 Il=1,NM1 LIN 132¢ 
Il=N- II LIN 133¢ 

SUM = ¢.@D0 LIN 134¢ 
IPl=I1I+ i LIN 135¢ 

DO 24@ J=IP1,N LIN 1360 

SUM = SUM + D(1,J)*R(J) LIN 1376 

246 CONTINUE LIN 138¢ 
R(I) = (R(I)-SUM) /D(1,1) LIN 139¢ 

GO TO (256, 266, 25@, 260), OPTION LIN 1466 

25@ X(I) = R(I) LIN 141¢ 
GO TO 27¢ 7 LIN 142¢ 

260 X(I) = X(I) + R(I) LIN 143¢ 
27@ CONTINUE LIN 1449 

C SOLUTION OF LINEAR SYSTEM IS COMPLETE. RETURN FOR OPTION=1,3. LIN 145¢ 
GO TO (284, 296, 2806, 290), OPTION LIN 1466 

28@ RETURN LIN 147¢ 
299 GO TO (130, 300), ISWIT LIN 148¢ 

C CALCULATE ERRORS BASED ON CORRECTION. LIN 149¢ 
300 NORMX = 0.OD¢ LIN 15¢6¢ 
NORME = @.@D@ LIN 1510 

DO 31@ I=1,N LIN 1520 

NORMX = DMAX1 (NORMX,DABS(X(I))) LIN 1530 

NORME = DMAX1 (NORME,DABS(R(I))) LIN 1540 

316 CONTINUE LIN 155@ 
ERROR = NORME/NORMX LIN 156@ 
RETURN LIN 1570 

END LIN 158¢ 
SUBROUTINE IEGAUS(KERNEL, RHFCN, A, B, EP, IFLAG, X, T, NT, IEG 1@ 

* NUPPER, MUPPER, W, IER) IEG 26 

C THE INTEGRAL EQUATION BEING SOLVED IS IEG 36 
Cc B IEG 4 
Cc X(S) - INT KERNEL(S,T)*X(T)*DT = RHFCN(S) IEG 5¢@ 
Cc A IEG 6¢ 
C THE METHOD BEING USED IS BASED ON THE NYSTROM METHOD WITH IEG 76 
C GAUSSIAN QUADRATURE, WITH AN ITERATIVE TECHNIQUE OF SOLUTION IEG 8@ 
C FOR THE RESULTING LINEAR SYSTEM. IEG 96 
C KERNEL THESE ARE DOUBLE PRECISION FUNCTIONS OF TWO AND ONE IEG 1606 
C RHFCN VARIABLES, RESPECTIVELY. THEY MUST BE DECLARED IN AN IEG 11¢@ 
6 EXTERNAL STATEMENT IN THE PROGRAM CALLING IEGAUS. IEG 12¢ 
Cc EP THE DESIRED ERROR. THE VARIABLE EP IS CHANGED ON IEG 13¢ 
c COMPLETION OF THE PROGRAM. SEE THE DISCUSSION OF IER IEG 1406 
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IFLAG =@ 


X 


NT 


NUPPER 


MUPPER 


IER =@ 


=6 
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AND IFLAG FOR MORE INFORMATION. 

EP IS INTERPRETED AS AN ABSOLUTE ERROR TOLERANCE. 

EP IS INTERPRETED AS A RELATIVE ERROR TOLERANCE. 

THE COMPUTED APPROXIMATE SOLUTION OF THE INTEGRAL 
EQUATION, EVALUATED AT THE NODE POINTS IN T, IS 
STORED IN X ON COMPLETION OF THE ROUTINE. THIS IS 
TRUE IRREGARDLESS OF WHETHER OR NOT THE DESIRED ERROR 
TOLERANCE WAS ATTAINED. 

CONTAINS THE NODE POINTS AT WHICH THE SOLUTION OF THE 
INTEGRAL EQUATION IS DESIRED. SEE THE VARIABLE NT FOR 
MORE INFORMATION. 

IF NT=$, THEN T AND X WILL BE SET EQUAL TO THE FINAL 
GAUSSIAN NODES AND THE CORRESPONDING SOLUTION VALUES, 
AND NT WILL BE SET TO THE NUMBER OF THE SOLUTION 
VALUES STORED IN X AND T. THE ARRAYS T AND X SHOULD 
HAVE DIMENSION AT LEAST MUPPER, ASSIGNED IN THE 
CALLING PROGRAM. 

IF NT .GT. @, THEN T CONTAINS NT USER SUPPLIED NODES 
AT WHICH THE SOLUTION X IS DESIRED. 

AN UPPER LIMIT ON THE VARIABLE N IN THIS PROGRAM. 

N IS THE ORDER OF A LINEAR SYSTEM WHICH IS BEING 
USED TO ITERATIVELY SOLVE A LARGER LINEAR SYSTEM OF 
ORDER M WHICH APPROXIMATES THE ABOVE INTEGRAL 
EQUATION. 

AN UPPER LIMIT ON THE VARIABLE M IN THE PROGRAM. 

N AND M ARE ALWAYS POWERS OF TWO. 

TEMPORARY WORKING STORAGE FOR THE PROGRAM. IT MUST 
CONTAIN AT LEAST 5*NU*NU+9* (NU4MU) POSITIONS, WITH 
NU=NUPPER, MU=MUPPER. 

THIS ERROR COMPLETION CODE MEANS THE ROUTINE WAS 
COMPLETED SATISFACTORILY. EP CONTAINS THE PREDICTED 
ERROR. 

THE ERROR TEST WAS NOT SATISFIED. EP CONTAINS THE 
PREDICTED ERROR. 

THE ERROR TEST WAS NOT SATISFIED. EP HAS BEEN SET 

TO ZERO. 

THE ORIGINAL VALUE OF EP WAS TOO SMALL, DUE TO 
POSSIBLE ILL-CONDITIONING PROBLEMS IN THE INTEGRAL 
EQUATION. THE VALUE OF EP WAS RESET TO A MORE 
REALISTIC VALUE, AND THAT TOLERANCE WAS ATTAINED. 
THE ERROR WAS SATISFACTORY AT THE GAUSSIAN NODE 
POINTS (LER=¢), BUT THE INTERPOLATION PROCESS(DUE TO 
NT .GT. @) MAY NOT PRESERVE THIS ACCURACY. CHECK THE 
VALUE OF NORM(K) FOR POSSIBLE INDICATIONS THAT THE 
INTEGRAL EQUATION MAY BE ALMOST FIRST KIND. SUCH 
EQUATIONS ARE QUITE ILL-CONDITIONED. THE ERROR IN EP 
IS THE PREDICTED ERROR FOR THE SOLUTION AT THE 
GAUSSIAN NODE POINTS OF ORDER MFINAL. 

THE ANALOGUE OF IER=4, BUT WITH IER=1 AT THE 
GAUSSIAN NODE POINTS. 

THE ANALOGUE OF IER=4, BUT WITH IER=3 AT THE 
GAUSSIAN NODE POINTS. 


IEGAUS IS PRESENTLY LIMITED TO NUPPER .LE. 16¢. THIS IS ENTIRELY 
DUE TO A RESTRICTION IN THE PROGRAM LINSYS. TO REMOVE THIS 
RESTRICTION, CHANGE THE DIMENSION STATEMENTS IN THE 
COMMON /LINEAR/ STATEMENTS IN LINSYS AND THE SUBPROGRAM LEGS. 

DOUBLE PRECISION KERNEL, RHFCN, A, B, EP, X, T, W, CUTOFF, 

*® ROOTRT, UNITRD, R1, R2, FINLEP, NORMK 

DIMENSION X(1), T(1), WC(1) 

EXTERNAL KERNEL, RHFCN 
RHARKKKEKKEKKEKKKEKREKEREREREKRRKEKREARRRRERERERRERERRERARERERKEREREKERERKR 


COMMON /INFO/ Rl, R2, FINLEP, NORMK, NFINAL, MFINAL 


THE NUMBERS IN INFO GIVE ADDITIONAL INFORMATION ABOUT THE 


FUNCTIONING OF IEGAUS. Rl IS THE ITERATIVE RATE OF CONVERGENCE 
IN THE MOST RECENTLY COMPUTED LINEAR SYSTEM. R2 IS THE RATE OF 


CONVERGENCE OF THE GAUSSIAN QUADRATURE VARIANT OF THE NYSTROM 
METHOD. FINLEP IS THE FINAL VALUE OF EP USED AS THE DESIRED 
ERROR TOLERANCE. USUALLY FINLEP WILL EQUAL THE INPUT VALUE OF 
EP, UNLESS EP WAS MUCH TOO SMALL. NORMK IS AN APPROXIMATE 
VALUE FOR THE NORM OF THE INTEGRAL OPERATOR K, AND IT IS 
CALCULATED ONLY IF NT .GT. @. 

NFINAL AND MFINAL ARE THE FINAL VALUES OF N AND M USED IN 
TEGAUS. IF NFINAL=MFINAL, THEN ITERATION WAS NOT INVOKED 
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DO 14@ J=1,N 
SUM = SUM + A(I,J)*X(J) 
14@ CONTINUE 
R(I) = B(I) - SUM 
15@ CONTINUE 
NORMB = @.@D¢ 
NORMR = %.@D¢@ 
DO 16¢ I=1,N 
NORMB = DMAX1(NORMB,DABS(B(I))) 
NORMR = DMAX1 (NORMR,DABS(R(I))) 
16@ CONTINUE 
RELRSD = NORMR/NORMB 
ISWIT = 2 
SOLVE P*L*Z=R AND STORE IN R. 
176 NMl =N-1 
DO 2¢@ K=1,NM1 
IF (PIVOT(K).EQ.K) GO TO 18@ 
KPIV = PIVOT(K) 
TEMP = R(K) 
R(K) = R(KPIV) 
R(KPIV) = TEMP 
186 KPlL=K+1 
DO 19@ I=KP1,N 
R(I) = R(I) - D(I,K)*R(K) 
199 CONTINUE 
2¢@ CONTINUE 
SOLVE U*E=R AND STORE IN R. ALSO LET X=X+E. 
R(N) = R(N)/D(N,N) 
GO TO (21, 220, 210, 226), OPTION 
210 X(N) = R(N) 
GO TO 23¢ 
22@ X(N) = X(N) + R(N) 
23@ DO 270 II=1,NM1 


I=N-II 
SUM = @.@D¢ 
IPl=I+1 


DO 246 J=IP1,N 
SUM = SUM + D(1,J)*R(J) 

246 CONTINUE 

R(I) = (R(I)-SUM) /D(I,I) 

GO TO (25, 260, 25@, 260), OPTION 
25@ X(I) = R(T) 

GO TO 27¢ 
260 xX(I) = X(1) + R(I) 
276 CONTINUE 
SOLUTION OF LINEAR SYSTEM IS COMPLETE. RETURN FOR OPTION=1,3. 

GO TO (28, 290, 28@, 290), OPTION 

286 RETURN 
299 GO TO (130, 300), ISWIT 


C CALCULATE ERRORS BASED ON CORRECTION. 
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360 NORMX = 0.@D¢ 
NORME = ¢.@D@ 
DO 31¢ I=1,N 
NORMX = DMAX1 (NORMX,DABS (X(I))) 
NORME = DMAX1 (NORME,DABS(R(I))) 
310 CONTINUE 
ERROR = NORME/NORMX 
RETURN 
END 


SUBROUTINE IEGAUS(KERNEL, RHFCN, A, B, EP, IFLAG, X, T, NT, 
* NUPPER, MUPPER, W, IER) 
THE INTEGRAL EQUATION BEING SOLVED IS 
B 
X(S) - INT KERNEL(S,T)*X(T)*DT = RHFCN(S) 
A 
THE METHOD BEING USED IS BASED ON THE NYSTROM METHOD WITH 
GAUSSIAN QUADRATURE, WITH AN ITERATIVE TECHNIQUE OF SOLUTION 
FOR THE RESULTING LINEAR SYSTEM. 


KERNEL THESE ARE DOUBLE PRECISION FUNCTIONS OF TWO AND ONE 

RHFCN VARIABLES, RESPECTIVELY. THEY MUST BE DECLARED IN AN 
EXTERNAL STATEMENT IN THE PROGRAM CALLING IEGAUS. 

EP THE DESIRED ERROR. THE VARIABLE EP IS CHANGED ON 


COMPLETION OF THE PROGRAM. SEE THE DISCUSSION OF IER 
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IFLAG =@ 
=] 
xX 


NT 


NUPPER 


MUPPER 


IER =@ 


AND IFLAG FOR MORE INFORMATION. 

EP IS INTERPRETED AS AN ABSOLUTE ERROR TOLERANCE. 

EP IS INTERPRETED AS A RELATIVE ERROR TOLERANCE. 

THE COMPUTED APPROXIMATE SOLUTION OF THE INTEGRAL 
EQUATION, EVALUATED AT THE NODE POINTS IN T, IS 
STORED IN X ON COMPLETION OF THE ROUTINE. THIS IS 
TRUE IRREGARDLESS OF WHETHER OR NOT THE DESIRED ERROR 
TOLERANCE WAS ATTAINED. 

CONTAINS THE NODE POINTS AT WHICH THE SOLUTION OF THE 
INTEGRAL EQUATION IS DESIRED. SEE THE VARIABLE NT FOR 
MORE INFORMATION. 

IF NT=@, THEN T AND X WILL BE SET EQUAL TO THE FINAL 
GAUSSIAN NODES AND THE CORRESPONDING SOLUTION VALUES, 
AND NT WILL BE SET TO THE NUMBER OF THE SOLUTION 
VALUES STORED IN X AND T. THE ARRAYS T AND X SHOULD 
HAVE DIMENSION AT LEAST MUPPER, ASSIGNED IN THE 
CALLING PROGRAM. 

IF NT .GT. @, THEN T CONTAINS NT USER SUPPLIED NODES 
AT WHICH THE SOLUTION X IS DESIRED. 

AN UPPER LIMIT ON THE VARIABLE N IN THIS PROGRAM. 

N IS THE ORDER OF A LINEAR SYSTEM WHICH IS BEING 
USED TO ITERATIVELY SOLVE A LARGER LINEAR SYSTEM OF 
ORDER M WHICH APPROXIMATES THE ABOVE INTEGRAL 
EQUATION. 

AN UPPER LIMIT ON THE VARIABLE M IN THE PROGRAM. 

N AND M ARE ALWAYS POWERS OF TWO. 

TEMPORARY WORKING STORAGE FOR THE PROGRAM. IT MUST 
CONTAIN AT LEAST 5*NU*NU+9* (NU+MU) POSITIONS, WITH 
NU=NUPPER, MU=MUPPER. 

THIS ERROR COMPLETION CODE MEANS THE ROUTINE WAS 
COMPLETED SATISFACTORILY. EP CONTAINS THE PREDICTED 
ERROR. 

THE ERROR TEST WAS NOT SATISFIED. EP CONTAINS THE 
PREDICTED ERROR. 

THE ERROR TEST WAS NOT SATISFIED. EP HAS BEEN SET 

TO ZERO. 

THE ORIGINAL VALUE OF EP WAS TOO SMALL, DUE TO 
POSSIBLE ILL-CONDITIONING PROBLEMS IN THE INTEGRAL 
EQUATION. THE VALUE OF EP WAS RESET TO A MORE 
REALISTIC VALUE, AND THAT TOLERANCE WAS ATTAINED. 
THE ERROR WAS SATISFACTORY AT THE GAUSSIAN NODE 
POINTS (IER=@¢), BUT THE INTERPOLATION PROCESS(DUE TO 
NT .GT. 0) MAY NOT PRESERVE THIS ACCURACY. CHECK THE 
VALUE OF NORM(K) FOR POSSIBLE INDICATIONS THAT THE 
INTEGRAL EQUATION MAY BE ALMOST FIRST KIND. SUCH 
EQUATIONS ARE QUITE ILL-CONDITIONED. THE ERROR IN EP 
IS THE PREDICTED ERROR FOR THE SOLUTION AT THE 
GAUSSIAN NODE POINTS OF ORDER MFINAL. 

THE ANALOGUE OF IER=4, BUT WITH IER=1 AT THE 
GAUSSIAN NODE POINTS. 

THE ANALOGUE OF IER=4, BUT WITH IER=3 AT THE 
GAUSSIAN NODE POINTS. 


IEGAUS IS PRESENTLY LIMITED TO NUPPER .LE. 100. THIS IS ENTIRELY 
DUE TO A RESTRICTION IN THE PROGRAM LINSYS. TO REMOVE THIS 
RESTRICTION, CHANGE THE DIMENSION STATEMENTS IN THE 
COMMON/LINEAR/ STATEMENTS IN LINSYS AND THE SUBPROGRAM IEGS. 

DOUBLE PRECISION KERNEL, RHFCN, A, B, EP, X, T, W, CUTOFF, 

* ROOTRT, UNITRD, Rl, R2, FINLEP, NORMK 

DIMENSION X(1), T(1), W(1) 

EXTERNAL KERNEL, RHFCN 
RKKKKEKREKREKRRERERRERRKRERKRRRERRERKREKREREREKEEKERRERREREREREKRKKRRKKK 


COMMON /INFO/ R1, R2, FINLEP, NORMK, NFINAL, MFINAL 


THE NUMBERS IN INFO GIVE ADDITIONAL INFORMATION ABOUT THE 


FUNCTIONING OF IEGAUS. Rl IS THE ITERATIVE RATE OF CONVERGENCE 
IN THE MOST RECENTLY COMPUTED LINEAR SYSTEM. R2 IS THE RATE OF 


CONVERGENCE OF THE GAUSSIAN QUADRATURE VARIANT OF THE NYSTROM 


METHOD. 


FINLEP IS THE FINAL VALUE OF EP USED AS THE DESIRED 


ERROR TOLERANCE. USUALLY FINLEP WILL EQUAL THE INPUT VALUE OF 
EP, UNLESS EP WAS MUCH TOO SMALL. NORMK IS AN APPROXIMATE 
VALUE FOR THE NORM OF THE INTEGRAL OPERATOR K, AND IT IS 
CALCULATED ONLY IF NT .GT. @. 

NFINAL AND MFINAL ARE THE FINAL VALUES OF N AND M USED IN 


TEGAUS. 


IF NFINAL=MFINAL, THEN ITERATION WAS NOT INVOKED 


* 


i i 
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18¢ 
190 
200 
21¢ 
220 
230 
246 
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260 
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280 
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320 
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390 
400 
41¢ 
420 
430 
446 
450 
460 
470 
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49¢ 
500 
510 
52@ 
530 
540 
550 
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570 
580 
59@ 
600 
61¢ 
626 
630 
640 
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700 
71¢ 
726 
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81¢ 
820 
830 
840 
850 
860 
870 
880 
890 


503-P12- 


0 


COLLECTED ALGORITHMS (cont.) 


SUCCESSFULLY. 


DATA UNITRD /2.22D-16/ 


UNITRD IS THE SMALLEST NUMBER U FOR WHICH 

1+U .GT. 1. 
UNITRD VARIES WITH THE COMPUTER AND WITH THE ARITHMETIC BEING 
USED. TO CHANGE TO ANOTHER ARITHMETIC, UNITRD MUST BE CHANGED. 
BUT UNITRD ALSO REFLECTS THE ACCURACY OF THE CONSTANTS USED 
IN SUBROUTINE WANDT. 


DATA CUTOFF /@.5D@/, ROOTRT /@.1D0/ 


C SET UP THE RELAVIVE BASE ADDRESSES FOR THE VARIOUS ARRAYS INTO 
C WHICH W IS TO BE SPLIT. 


N = NUPPER 

M = MUPPER 

NSQ = N&*N 
Il=1l 

I2 = Il + NSQ 
13 = 12 + NSQ 
14 = 13 + NSQ/2 
I5 = I4 + NSQ/2 
I16=I15+M 

I7 = 16 +M 

I8 = I7+N 

19 = 18 +N 

I11¢ = 19 +M 
Ill = I1@+N 
112 = Ill +M 
113 = 112 + M 
114 = 113 + M 
115 = L14+N 
116 = 115 +™M 
117 = 116 +M 
118 = I17 +N 
119 = 118+ M 
12@ = 119 + 4*N 
I21 = 12¢ + NSQ 
NHALF = N/2 


CALL IEGS(KERNEL, RHFCN, A, B, EP, IFLAG, X, T, NT, NUPPER, 
* MUPPER, IER, CUTOFF, ROOTRT, UNITRD, NHALF, W(I1), W(I2), 
* W(L3), W(I4), W(I5), W(16), W(I7), W(I8), W(19), W(I1@), 
* W(I11), W(I12), W(I13), W(I14), W(115), W(I16), W(I17), 
* W(I18), W(I19), W(I26), W(121)) 

RETURN 

END 


SUBROUTINE IEGS(KERNEL, RHFCN, A, B, EP, IFLAG, X, T, NT, 
* NUP, MUP, IER, CUTOFF, ROOTRT, UNITRD, NHALF, LUFACT, KMM, 
* KMN, KNM, RHS, R, RH, DELN, TM, TN, XM, XMZ, WM, WN, OLDX, 
* SAVE, XN, SAVE2, ASIDE, ASIDE3, IMKNN) 


C THIS ROUTINE CONTROLS THE SOLUTION OF THE INTEGRAL EQUATION. 


DOUBLE PRECISION KERNEL, RHFCN, A, B, EP, X, T, CUTOFF, 
ROOTRT, UNITRD, LUFACT, KMM, KMN, KNM, RHS, R, RH, DELN, TM, 
TN, XM, XMZ, WM, WN, OLDX, SAVE, XN, SAVE2, ASIDE, ASIDE2, 
ASIDE3, IMKNN, RESID, SCALE, ELINSY, RELRSD, XNORM, PASTC, 
PASTRE, R1, R2, FINLEP, NORMK, DFLOAT, NORM, CONEW, RMIN, 
RIRAT, COND, AVERR, EPS, DET, RELMIN, DMIN1, DMAX1, DSQRT, 
ERROR, NUMR2, DENR2, TEMP2, RELERR, NUMR1, DENR1, RATE, 
TEMP, RT, ESTERR, TEST 
INTEGER FLAG, OLDM 

DIMENSION X(l), T(1), LUFACT(NUP,NUP), KMM(NUP,NUP), 

* RHS(MUP), KNM(NHALF,NUP), KMN(NUP,NHALF), R(MUP), RH(NUP), 

* DELN(NUP), TM(MUP), TN(NUP), XM(MUP), XMZ(MUP), WM(MUP), 

* WN(NUP), OLDX(MUP), SAVE(MUP), XN(NUP), SAVE2(MUP), 

* ASIDE(NUP,4), ASIDE2(5), ASIDE3(NUP,NUP), IMKNN(NUP,NUP) 
COMMON /LINEAR/ RESID(1@@), SCALE(1¢@), ELINSY, RELRSD, 

* IPIVOT (100) 

COMMON /INFO/ Rl, R2, FINLEP, NORMK, NFINAL, MFINAL 
EXTERNAL KERNEL, RHFCN 


be a 


C INITIALIZATION 


x 
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COLLECTED ALGORITHMS (cont.) 


LOOP = 1 

N= 2 

R2 = @.5D@ 

M = 2*N 

RIRAT = ROOTRT 
COND = 1.@D¢@ 


PASTC = 1.@D@ 
PASTRE = $.@D@ 
EPS = EP 
STAGE A. DIRECT SOLUTION OF LINEAR SYSTEM (I-KN)*XN=RHS, WHILE 
TRYING TO FIND A GOOD APPROXIMATE INVERSE TO IMPLEMENT 
ITERATIVE METHOD OF SOLUTION. 
CREATE THE NODES AND WEIGHTS TN(L) AND WN(I), I=1,...,N 
CALL WANDT(WN, TN, N, A, B) 
SET UP MATRIX FOR (I-KN)*XN=RHFCN 
DO 20 J=1,N 
DO 1¢ I=1,N 
IMKNN(I,J) = -WN(J)*KERNEL(TN(I) ,TN(J)) 
16 CONTINUE 
XMZ(J) = RHFCN(TN(J)) 
IMKNN(J,J) = IMKNN(J,J) + 1.6D¢ 
26 CONTINUE 
GO TO 6¢ 
THIS IS ENTRANCE FOR AN INCREASED VALUE OF N, USING PREVIOUSLY 
STORED VALUES IN KMM TO DEFINE MATRIX FOR (I-KN)*XN=RHFCN WITH 
NEW VALUE OF N. 
39 DO 59 J=1,N 
DO 40 I=1,N 
IMKNN(I,J) = -KMM(I,J) 
4@ CONTINUE 
WN(J) = WM(J) 
IN(J) = TM(J) 
XMZ(J) = RHS(J) 
IMKNN(J,J) = IMKNN(J,J) + 1.0D¢ 
5@ CONTINUE 
C THIS IS THE ENTRANCE WHEN ITERATION IN STAGE B FAILS AND WE NEED 
C TO INCREASE N TO OBTAIN A BETTER ITERATIVE RATE. 
60 CONTINUE 
C SOLVE (I-KN)*XN=RHFCN AT ALL TN(1).ALSO OBTAIN THE LU 
Cc DECOMPOSITION FOR LATER USE IN THE STAGE B ITERATIVE METHOD. 
Cc 
6 


QAaaAaAN 


Qa 


aaa 
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CALL LINSYS(IMKNN, LUFACT, N, XMZ, XN, 2, DET, NUP) 


Cc 

Cc LINSYS IS A GENERAL LINEAR EQUATION SOLVER. IT HAS SPECIAL 
C OPTIONS WHICH ARE USED IN THE FOLLOWING PROGRAM, AND THUS 
C LINSYS SHOULD NOT BE REPLACED BY ANOTHER LINEAR EQUATION 

. PROGRAM. LINSYS IS ALSO USED IN THE SUBROUTINE ITERT. 

C 
C 


+e Fe FO OF 
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COND = CONEW(COND,ELINSY,RELRSD,AVERR, PASTC , PASTRE) 
RELMIN = RMIN(N,N,COND,UNITRD,AVERR) 
IF (LOOP.EQ.1) GO TO 14@ 
IF (LOOP.EQ.2) GO TO 8¢@ 
C SET UP APPROXIMATE RATE OF CONVERGENCE OF SOLUTIONS XN TO TRUE 
SOLUTION X. ALSO SET UP DESIRED RATIO FOR ITERATIVE METHOD. 
NUMR2 = NORM(XN,OLDX,N,1) 
R2 = DMIN1(@.5D@,DMAX1 (NUMR2/DENR2,1.@D-4) ) 
RIRAT = DMIN1 (ROOTRT ,DSQRT(R2)) 
CHECK FOR ERROR IN XN USING TEST INVOLVING R2 AND OLDX,ACCORDING 
TO THEORY FOR ASYMPTOTIC ERROR BOUNDS. MODIFY ERROR IF IT IS 
OUTSIDE PRECISION RANGE OF COMPUTER, POSSIBLY DUE TO 
ILL-CONDITIONING. 
7@ ERROR = (R2/(1.@D@-R2) )*NUMR2 
XNORM = NORM(XN,XN,N,@) 
RELERR = ERROR/XNORM 
IF (IFLAG.EQ.@) EPS = DMAX1(EP,XNORM*RELMIN) 
IF (IFLAG.EQ.1) EPS = DMAX1(EP,RELMIN) 
IF (IFLAG.EQ.1) ERROR = DMAX1 (RELERR,RELMIN) 
IF ((IFLAG.EQ.@) .AND. (RELERR.LT.RELMIN)) ERROR = 
* RELMIN*XNORM 
IF (ERROR.LE.EPS) GO TO 9¢ 
DENR2 = NUMR2 
GO TO 10¢ 
C ENTRANCE FOR LOOP=2. 
8@ NUMR2 = NORM(XN,OLDX,N,1) 
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ome neke) 


aan 


aan 


DENR2 = ¢.@D0 
GO TO 70 
EXIT FOR SUCCESSFUL RETURN. ITERATION WAS NOT NECESSARY. 
9% CALL LEAVE(@, N, N, XN, TN, WN, ERROR, KERNEL, RHFCN, EP, 
* IFLAG, X, T, NT, IER, EPS, ELINSY, TN, WN, TM, WM, XM, XMZ, 
* KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, 
* XNORM) 
RETURN 

ATTEMPT TO SOLVE (I-KM)*XM=RHFCN ITERATIVELY, CHECKING TO SEE IF 

THE RATE OF CONVERGENCE IS SUFFICIENTLY FAST SO AS TO ENTER 

STAGE B. 

CALCULATE TM(I) AND WM(I), I=1,...,M. 

16@ CALL WANDT(WM, TM, M, A, B) 

FLAG = 0 

CALCULATE INITIAL GUESS XMZ FOR ITERATION METHOD. 

CALL INTERP(TM, WM, XMZ, M, TN, WN, XN, N, KERNEL, RHFCN, 
* RHS, KMN, NHALF, NUP) 
DO 11 I=1,M 

OLDX(I) = XMZ(1) 

11@ CONTINUE 

CALCULATE FIRST ITERATE. 

CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 
* KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
COND = CONEW(COND ,ELINSY,RELRSD ,AVERR, PASTC , PASTRE) 
DENR1 = NORM(XM,XMZ,M,1) 
FLAG = 1 
DO 12¢ I=1,M 

XMZ(1) = XM(I) 

12¢@ CONTINUE 

CALCULATE SECOND ITERATE. 

CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 
* KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
COND = CONEW(COND,ELINSY,RELRSD,AVERR, PASTC, PASTRE) 
NUMR1 = NORM(XM,XMZ,M,1) 
CHECK ON THE SPEED OF CONVERGENCE OF ITERATIVE METHOD. IF IT IS 
SUFFICIENTLY RAPID, THEN FIX N AND GO TO STAGE B. 
Rl = NUMR1/DENR1 ; 
RATE = Rl 
IF (M.GT.NUP) GO TO 17¢ 
IF (R1.LE.RIRAT) GO TO 13¢ 

THE ITERATION DID NOT WORK WELL ENOUGH, AND STAGE A IS TO BE 

REPEATED. RE-INITIALIZE FOR SOLVING (1-KN)*XN=RHFCN AGAIN 

WITH A LARGER N. 

N=M 

LOOP = LOOP + 1 
M = 24N 

GO TO 30 

THE ITERATIVE RATE IS SUFFICIENTLY RAPID, AND CONTROL WILL GO TO 

STAGE B. SAVE INFORMATION IN CASE STAGE B ABORTS AT A LARGER 

VALUE OF M AND STAGE A HAS TO BE RETURNED TO. 

13¢@ DO 14¢ I=1,M 

ASIDE(I,1) = OLDX(I) 
ASIDE(I,2) = WM(1) 
ASIDE(I,3) = TM(1) 
ASIDE(I,4) = RHS(I) 

146 CONTINUE 
ASIDE2(1) 
ASIDE2 (3) 
ASIDE2(4) = DENR2 
ASIDE2(5) = RLRAT 
DO 16@ J=1,M 

DO 15@ I=1,M 
ASIDE3(1,J) = KMM(I,J) 

15@ CONTINUE 

16¢@ CONTINUE 

STAGE B. ITERATIVE METHOD OF SOLUTION OF (I-KM)*XM=RHS. 

17@ OLDM = N 
ASIDE2(2) = M 
IF (R1.LE.CUTOFF) GO TO 20 

THE ITERATES ARE CONVERGING VERY SLOWLY OR NOT AT ALL. THUS 

RETURN WITHOUT FURTHER ATTEMPTS TO LESSEN THE ERROR. 

IF (LOOP.NE.1) GO TO 19¢ 

18@ CALL LEAVE(2, N, N, XN, TN, WN, @.@D@, KERNEL, RHFCN, EP, 

* IFLAG, X, T, NT, IER, EPS, ELINSY, TN, WN, TM, WM, XM, XMZ, 
* KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, 
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* XNORM) 
RETURN 
199 CALL LEAVE(1, N, N, XN, TN, WN, ERROR, KERNEL, RHFCN, EP, 
* IFLAG, X, T, NT, IER, EPS, ELINSY, TN, WN, TM, WM, XM, XMZ, 
* KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, 
* XNORM) 
RETURN 
TEST TO SEE IF THE CURRENT ITERATE XM IS SUFFICIENTLY ACCURATE 
COMPARED TO THE TRUE XM. 
2¢@ RATE = RI*RATE 
TEMP = NORM(XM,OLDX,M, 1) 
IF (LOOP.EQ.1) TEMP2 = @.5D@ 
IF (LOOP.GT.1) TEMP2 = TEMP/DENR2 
RT = DMIN1(@.@1D@,DMAX1 (TEMP2,@.9¢0@1D0) )/2.@D@ 
XNORM = NORM(XM,XM,M,@) 
ESTERR = (RT/(1.@D@-RT) ) *TEMP/XNORM 
IF (ESTERR.LT.RELMIN) ESTERR = RELMIN 
ESTERR = ESTERR*XNORM 
TEST = ((1.@D@-R1)/R1)*ESTERR 
IF (NUMRI.LE.TEST) GO TO 260 
ITERATE NOT SUFFICIENTLY ACCURATE. INITIALIZE FOR COMPUTATION 
OF ANOTHER ITERATE. 
DENR1 = NUMRI1 
DO 210 I=1,M 
XMZ(I) = XM(I) 
21@ CONTINUE 
CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, 
* KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) 
COND = CONEW(COND,ELINSY,RELRSD ,AVERR, PASTC , PASTRE) 
NUMR1 = NORM(XM,XMZ,M,1) 
Rl = NUMR1/DENR1 
IF (R1.LE.CUTOFF) GO TO 2¢@¢ 
THIS IS ENTRANCE FOR CASE WHERE ITERATION FAILS IN STAGE B. 
PARAMETERS MUST BE RESET FOR A RETURN TO STAGE A OR FOR AN 
ABORTIVE EXIT IF N CANNOT BE INCREASED ANY FURTHER. 
22@ MNEW = ASIDE2(2) 
IF (MNEW.GT.NUP) GO TO 25¢ 
N = MNEW 
DO 246 J=1,N 
DO 23¢ I=1,N 
IMKNN(I,J) = -ASIDE3(I,J) 
230 CONTINUE 
OLDX(J) = ASIDE(J,1) 
WN(J) = ASIDE(J,2) 
TN(J) = ASIDE(J, 3) 
XMZ(J) = ASIDE(J,4) 
IMKNN(J,J) = IMKNN(J,J) + 1.QD0 
24@ CONTINUE 
M = 2*N 
LOOP = ASIDE2(1) + 1.9D@ 
R2 = ASIDE2(3) 
DENR2 = ASIDE2(4) 
RLRAT = ASIDE2(5) 
GO TO 60 
ABORTIVE EXIT FROM STAGE B. N CANNOT BE INCREASED FURTHER, AND 
Rl IS NOT SUFFICIENTLY SMALL. 
25@ IF (LOOP.EQ.1) GO TO 18¢@ 
CALL WANDT(WM, TM, OLDM, A, B) 
CALL LEAVE(1, N, OLDM, SAVE, TM, WM, ERROR, KERNEL, RHFCN, 
* EP, IFLAG, X, T, NI, IER, EPS, ELINSY, TN, WN, TM, WM, XM, 
* XMZ, KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, 
* NHALF, XNORM) 
RETURN 
AN ACCURATE VALUE OF XM HAS BEEN OBTAINED. R2 IS TO BE TESTED AS 
TO WHETHER IT SHOULD BE RESET. THEN CHECK ERROR IN XM COMPARED 
WITH THE TRUE SOLUTION X. 
260 IF (LOOP.EQ.1) GO TO 290 
NUMR2 = TEMP 
R2 = DMAX1(1.@D-4,RATE,DMIN1 (NUMR2/DENR2,@.5D@) ) 


DENR2 = NUMR2 
27@ ERROR = (R2/(1.@D@-R2) )*TEMP 
XNORM = NORM(XM,XM,M,9@) 


RELERR = ERROR/XNORM 

RELMIN = RMIN(N,M,COND,UNITRD,AVERR) 

IF (IFLAG.EQ.@) EPS = DMAX1(EP,XNORM*RELMIN) 
IF (IFLAG.EQ.1) EPS = DMAX1(EP,RELMIN) 
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IF (IFLAG.EQ.1) ERROR = DMAX1 (RELERR, RELMIN) IEG 252¢ 

IF ((IFLAG.EQ.@) .AND. (RELERR.LT.RELMIN)) ERROR = IEG 253¢ 

* RELMIN*XNORM IEG 2546 

IF (ERROR.GT.EPS) GO TO 28¢ IEG 2550 

CALL LEAVE(@, N, M, XM, TM, WM, ERROR, KERNEL, RHFCN, EP, IEG 256¢ 

* IFLAG, X, T, NT, IER, EPS, ELINSY, TN, WN, TM, WM, XM, XMZ, IEG 257@ 

* KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, IEG 2586 

* XNORM) IEG 259¢ 
RETURN IEG 26066 

280 MNEW = 2*M IEG 2610 
IF (MNEW.LE.MUP) GO TO 300 IEG 2620 

C M CANNOT BE INCREASED ANY FURTHER. IEG 2630¢ 
CALL LEAVE(1, N, M, XM, TM, WM, ERROR, KERNEL, RHFCN, EP, IEG 264¢ 

* IFLAG, X, T, NT, IER, EPS, ELINSY, TN, WN, TM, WM, XM, XMZ, IEG 265¢ 

* KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, IEG 2666 

* XNORM) IEG 26706 
RETURN IEG 2686 

29% DENR2 = TEMP IEG 2696 
LOOP = 2 IEG 270 

GO TO 27¢ IEG 2716 

C ERROR NOT SUFFICIENTLY SMALL. M IS INCREASED AND TWO MORE IEG 2726 
C MORE ITERATES ARE COMPUTED WITH THE NEW M. IEG 273¢ 
300 OLDM = M IEG 2740 

M = MNEW IEG 275¢ 

DO 31@ I=1,OLDM IEG 276¢ 
SAVE2(L) = WM(I) IEG 277¢ 

SAVE(L) = TM(I) IEG 2786 

310 CONTINUE IEG 2796 
CALL WANDT(WM, TM, M, A, B) IEG 28¢6¢ 

FLAG = @ IEG 2816 

CALL INTERP(TM, WM, XMZ, M, SAVE, SAVE2, XM, OLDM, KERNEL, IEG 28206 

* RHFCN, RHS, KMN, NHALF, NUP) IEG 283¢ 

DO 32¢@ I=1,0LDM IEG 284¢ 
SAVE(L) = XM(I) IEG 28506 

32@ CONTINUE LEG 286¢ 
DO 33¢@ I=1,M IEG 2870 
OLDX(I) = XMZ(I) IEG 2886 

33@ CONTINUE LEG 28990 
CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, IEG 2900 

* KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) IEG 291¢ 

COND = CONEW(COND,ELINSY,RELRSD ,AVERR,PASTC, PASTRE) IEG 292¢ 

DENR1 = NORM(XM,XMZ,M,1) IEG 2930 

FLAG = 1 IEG 2946 

DO 34@ I=1,M IEG 2950 
XMZ(1I) = XM(I) IEG 2960 

34@ CONTINUE IEG 29706 
CALL ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, XMZ, KMM, IEG 2980 

* KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, FLAG) IEG 2996 

COND = CONEW(COND,ELINSY,RELRSD ,AVERR, PASTC, PASTRE) IEG 3000 

NUMR1 = NORM(XM,XMZ,M,1) IEG 3¢10 

Rl = NUMR1/DENR1 IEG 3¢62¢ 

RATE = Rl IEG 3¢36 

IF (R1.LE.CUTOFF) GO TO 26¢ IEG 304¢ 

GO TO 22¢ IEG 305¢ 

END IEG 3¢60 
SUBROUTINE WANDT(WV, TV, N, A, B) WAN 1¢ 

C INTEGRATION WEIGHTS AND NODES ARE TO BE CALCULATED AND STORED IN WAN 2@ 
C WV AND TV, RESPECTIVELY. N IS ASSUMED TO BE A POWER OF TWO. IF WAN 3@ 
C 2 .LE. N .LE. 256, THEN GAUSSIAN QUADRATURE IS USED. IF N .GT. WAN 4@ 
C 256, THEN THE INTERVAL (A,B) IS DIVIDED N/256 TIMES AND THE 256 WAN 5@ 
C POINT FORMULA IS APPLIED TO EACH SUBINTERVAL. WAN 6@ 
DOUBLE PRECISION WV, TV, A, B, W, T, FLOOP, H, SCALE, AL, BL, WAN 7@ 

* S, R, FL WAN 8@ 
DIMENSION WV(N), TV(N) WAN 9¢ 
DIMENSION W(255), 1T(255) WAN 160 

* T(1@), T(11), T(12), T(13), T(14), T(15) WAN 12@ 

* /.577350269189626D@, .861136311594053D¢, .339981043584856D0, WAN 13¢@ 

* .960289856497536DO, . 796666477413627D@, .525532409916329DO, WAN 14@ 

* .183434642495650D@, .989406934991650D0, .944575023073233D¢, WAN 150 

* ,865631202387832DO, . 755404408355003D0, .617876244402644D6, WAN 16 

* .458016777657227DQ, .281603550779259D@, .950125098376374D-1/ WAN 17¢ 


DATA T(16), T(17), T(18), T(19), T(20), T(21), T(22), T(23), WAN 180 
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* T(24), T(25), T(26), T(27), T(28), T(29), T(30), T(31) WAN 19¢ 
* /.997263861849482D@, .985611511545268DO, .964762255587506D0, WAN 26¢ 
* .934996075937740D0, .896321155766052D¢, .849367613732570D0, WAN 210 
* .794483795967942DG, .73218211874629@DG, .663644266930215D0, WAN 22 
* .587715757240762DO, .596899908932229DG, .421351276130635D¢, WAN 230 
* ,331868662282128D@, .239287 362252137D@, .144471961582796D¢, WAN 240 
* ,483076656877383D-1/ WAN 25@ 
DATA T(32), T(33), T(34), T(35), 1(36), T(37), T(38), 1T(39), WAN 260 
* T(40), T(41), T(42), T(43), 1(44), T(45), T(46), T(47) WAN 270 
* /.999305041735772DG, .996340116771955D@, .991613371476744D¢, WAN 28¢ 
* .983336253884626DO, .973326827789911DO, .9610068799652054D4, WAN 29¢ 
* ,946411374858403DO, .929569172131940DG, .9105221370785063D¢, WAN 36¢ 
* ,889315445995114D0, .865999398154093DO, .840629296252580D¢, WAN 3190 
* ,813265315122798D@, . 783972358943341DO, .752819907260532D0, WAN 32 
* .719881850171611D0/ WAN 33¢@ 
DATA T(48), T(49), T(50), T(51), T(52), T(53), T(54), T(55), WAN 34¢ 
* T(56), T(57), T(58), T(59), T(60), T(61), T(62), T(63) WAN 350 
* /,685236313054233D0, .648965471254657D@, .611155355172393D¢, WAN 360 
* ,5718956462062634DG, .531279464619895D0, .489403145707053D0, WAN 37¢ 
* .446366017253464D@, .402276157963992D¢, .357226158337668D¢, WAN 380 
* ,311322871990211DO, .264687162268767DO, .217423643740007D0, WAN 390 
* .169644420423993DG, .121462819296121D¢, .72993121787799@D-1, WAN 400 
* ,243502926634244D-1/ WAN 41¢ 
DATA T(64), T(65), T(66), T(67), T(68), T(69), T(76), T(71), WAN 42¢ 
* T(72), T(73), T(74), T(75), T(76), T(77), T(78), T(79) WAN 43¢ 
* /.999824887947132D¢, .999077459977376D@, .997733248625514D¢, WAN 44¢ 
* .995792758534981DO, .993257112900213DO, .999127818491734D0, WAN 45¢ 
* ,986406742724586DO, .982096108435719DO, .977198491463907D¢, WAN 460 
* .971716818747137DO, .965654366431965D0, .959014757853700D¢, WAN 47¢ 
* .951801961341264DG, .9440206287830220D0, .935674388277916D0, WAN 48 
* .926769250878948D0/ WAN 49¢ 
DATA T(8@), T(81), T(82), T(83), T(84), T(85), T(86), T(87), WAN 50¢ 
* T(88), T(89), T(90), T(91), T(92), T(93), T(94), T(95), WAN 51¢ 
* T(96), T(97) /.917310198086961D@, .967362883461757D¢, WAN 52@ 
* .896753288G649158D@, .885667717345397DO, .874952796958032D0, WAN 53¢@ 
* .861915468939548DO, .849262987577969DO, .836162915666907D0, WAN 54@ 
* ,822443116955644D0, .808291757507914D0, .793657294762193D¢, WAN 55¢@ 
* .778548475506412D0, .762974330044095D0, .746944166797062D9, WAN 56@ 
* ,7304675667419G9D0, .713554377683587DO, .696214708369514D¢, WAN 57 
* .678458922447719D0/ WAN 58¢ 
DATA T(98), T(99), T(100), T(1@1), T(162), T(103), T(164), WAN 5990 
* T(105), T(106), T(107), T(108), T(149), T(110), T(111), WAN 66¢ 
* T(112), T(113), T(114) /.660297632272646D¢, WAN 61¢ 
* .641741692562308DO, .622862193910585D0, .603490456158549DG, WAN 62¢ 
* ,583818021628763D0, .563796648226618D0, .543438302412810D¢, WAN 63¢@ 
* .522755152051175DO, .501759559136144D0, .480464072404172D¢, WAN 64@ 
® .458881419833552D@, .4370245019037104D0, .414966379552275D0, WAN 65¢@ 
* .392546275033267DO, . 369939555349859D0, .347117728597636D0, WAN 66¢ 
* .324088435024413D0/ WAN 670 
DATA T(115), T(116), T(117), T(118), T(119), T(120), T(121), WAN 680 
* T(122), T(123), T(124), T(125), T(126), T(127) WAN 69¢ 
* /.300865438877677DQ, .2774626201779G4DO, .253893966422694D0, WAN 76 
* ,230173564226660DO, .206315599902079DO, .182334305985337D¢, WAN 71¢ 
* .158244942714225DO, .134059199461188D0, .109794231127644D¢, WAN 72¢ 
* .854636405045155D-1, .619819696041396D-1, .366637999687335D-1, WAN 73¢@ 
* ,122236989606158D-1/ WAN 74@ 
DATA T(128), T(129), T(13@), T(131), T(132), T(133), T(134), WAN 75¢@ 
* T(135), T(136), T(137), T(138), T(139), T(14@), T(141), WAN 76@ 
* T(142) /.999956650018992DQ, .999768437409263D@, WAN 77¢ 
* ,999430937466261DG, .9989435258434G9DO@, .9983062664730G6D0, WAN 780 
* .997519252756721D@, .996582602023382DG, .995496454481696D¢G, WAN 790 
* .994266972922410DO, .992876342668822D0, .991342771207583D0, WAN 86¢ 
* .989660488745065D0, .987829747564861D9, .985850822286126D0, WAN 81¢ 
* .983724969760315D0/ WAN 820 
DATA T(143), T(144), T(145), T(146), T(147), T(148), T(149), WAN 830 
* T(15@), T(151), T(152), T(153), T(154), T(155), 1T(156), WAN 84@ 
* T(157) /.981449629625464D0, .979028621257622D¢, WAN 85¢@ 
*® .976459549719234D0, .973744599704370DO, .970883578480743D0, WAN 86¢ 
* .967876915228489DO, .96472596097576DO, .961428488530732D¢, WAN 87¢ 
* ,957987692411178D@, .954403188769716D0,..950675515316628D0, WAN 88 
* .946805231239127D@, .942792917117462D0, .938639174837814D¢, WAN 89¢ 
* .934344627502003D0/ WAN 906 
DATA T(158), T(159), T(160), T(161), T(162), T(163), T(164), WAN 91¢ 
* T(165), T(166), T(167), T(168), T(169), T(17@), T(171), WAN 92¢ 
* T(172) /.929969919334006D0, .925335715583316DG, WAN 930 


* .920622702425146D@, .915771586857490DO, .916783096595065DG, WAN 940 
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* .905657979960145D@, .990397005770304DO, .8950606963223085D0, WAN 950 
* ,889476661777611D@, .883896931033158D0, .878616620604707D¢, WAN 960 
* .872082599995488D¢, .866623758466555D@, .859835004903376D0, WAN 970 
* ,853517267679503D0/ WAN 980 
DATA T(173), T(174), T(175), T(176), T(177), T(178), T(179), WAN 990 
* T(180), T(181), T(182), T(183), T(184), T(185), T(186), WAN 1600 
* T(187) /.847071494517296DO, .840498652345763D¢, WAN 1061¢ 
* .8337997271555065D@, .826975723850813DG, .820027666098917D0, WAN 1020 
* .812956596176432D¢, .805763574812999DG, .798449681032171D0, WAN 1030 
* .791016011989546D@, . 783463682808184D0, .775793826411326D0, WAN 1040 
* .768007593352446DO, .760106151642655D@, . 752099686575492D0, WAN 105@ 
* .743962400549112D0/ WAN 1060 
DATA T(188), T(189), T(190), T(191), T(192), T(193), T(194), WAN 107¢ 
* T(195), T(196), T(197), T(198), T(199), T(260), T(2@1), WAN 1680 
* T(202) /.735722512885918D@, .727372259649652D¢, WAN 10696 
* ,718912893459971DQ, .710345683304543D@, . 761671914348685D0, WAN 1100 
* ,692892887742577D@, .684609926426076DO, .675024344931163D0, WAN 111¢ 
* ,665937509182049D0O, .656750776292973DG, .647465524363725D0, WAN 1120 
* .638983146272911DO, .628605049469915DO, .619932655759261D¢, WAN 1130 
* .609367401696334D0/ WAN 114@ 
DATA T(203), T(204), T(265), T(266), T(207), T(208), 1T(209), WAN 115@ 
* T(210), T(211), T(212), T(213), T(214), T(215), 1T(216), WAN 116¢ 
* T(217) /.599610735362968D@, .589764122154454D¢, WAN 1170 
* .579829038559983DO, .569866974936569DO, .559699434694481D¢, WAN 1180 
* .549507934062719D@, .539234601866059DG, .528879179294822D0, WAN 1190 
* .518445019673674D@, .507933088228616D0, .497344961852181D¢, WAN 1200 
* ,486682228866890D0, .475946488786983D@, .465139352078479D¢, WAN 1216 
* .45426243991759@D/ WAN 1220 
DATA T(218), T(219), T(226), T(221), T(222), 1(223), T(224), WAN 1230 
* 7(225), T(226), T(227), T(228), T(229), 1(23@), T(231), WAN 1240 
* (232) /.443317383947527DO, .432305826033741D¢, WAN 1250 
* .421229418017624DG, .419089821468717D0, .398888767435459D0, WAN 1260 
* .387627756194516D@, .376308656998716DG, .364933167823654D0, WAN 12706 
* .35350281511297OD@, .342019493522372DG, .330484865662417DG, WAN 1280 
* .31899006618401G6D@, .367268619799319D0, .295590484460136D0, WAN 1296 
* .283868007657682D0/ WAN 1300 
DATA T(233), 1(234), 1T(235), T(236), T(237), T(238), T(239), WAN 1310 
* 1(240), T(241), T(242), T(243), T( 244), T(245), 1(246), WAN 1320 
* T(247) /.272102947876337DO, .260297069991943D¢, WAN 1330 
* .2484521450610657D@, .236569949758284D0, .224652266769132D9, WAN 1340 
* .212700883622626D@, .260717593323127D, .188704193421389D¢, WAN 1350 
* .176662486044962D@, .164594277567554D0, .152561378338656D¢, WAN 1360 
* .149385602411376D@, .12824876727607DG, .116092693560333D0, WAN 1370 
* .1039192048105¢9D0/ WAN 1380 
DATA T(248), T(249), T(25@), T(251), 1(252), 1(253), T(254), WAN 1396 
* 7(255) /.917301271635196D-1, .795272891060233@D-1, WAN 1400 
* .673125211657164D-1, .55087655694634@D-1, .428545265363791D-1, WAN 1416 
* .30614968779979@D-1, .183768184788137D-1, .612391237518953D-2/ WAN 1420 
DATA W(1), W(2), W(3), W(4), W(5), W(6), W(7), W(8), W(9), WAN 1430 
* W(16), W(11), W(12), W(13), W(14), W(15) WAN 144@ 
* /1.0DQ@, .347854845137454D0, .652145154862546D0, WAN 1450 
* .1012285362906376D@, .222381034453374D0, .313706645877887D0, WAN 1460 
* ,362683783378362DQ, .271524594117541D-1, .622535239386479D-1, WAN 1470 
* .951585116824928D-1, .124628971255534D@, .149595988816577D¢, WAN 1480 
* .169156519395003D, .182603415044924DG, .189456610455068D0/ WAN 1490 
DATA W(16), W(17), W(18), W(19), W(20), W(21), W(22), W(23), WAN 1500 
* W(24), W(25), W(26), W(27), W(28), W(29), W(30), W(31) WAN 1510 
* /.7618619090094701OD-2, .162743947309057D-1, .253920653092621D-1, WAN 1520 
* ,342738629130214D-1, .428358986222267D-1, .509980592623762D-1, WAN 1530 
* .586840934785355D-1, .658222227763618D-1, .723457941088485D-1, WAN 1540 
* .781938957870703D-1, .833119242269468D-1, .876520930044038D-1, WAN 1550 
* .911738786957639D-1, .938443996898046D-1, .956387260792749D-1, WAN 1560 
* .965400885147278D-1/ WAN 1570 
DATA W(32), W(33), W(34), W(35), W(36), W(37), W(38)3 W(39), WAN 1580 
* W(40), W(41), W(42), W(43), W(44), W(45), W(46), W(47) WAN 159@ 
* /.178328072169643D-2, .414763326056247D-2, .650445796897836D-2, WAN 1600 
* ,884675982636395D-2, .111681394601311D-1, .134630478967186D-1, WAN 1610 
* .157260304760247D-1, .179517157756973D-1, .2013482315353@2D-1, WAN 1620 
* ,222701738083833D-1, .243527025687169D-1, .263774697150547D-1, WAN 1630 
*® ,283396726142595D-1, . 302346570724025D-1, .320579283548516D-1, WAN 164¢ 
* ,338051618371416D-1/ WAN 1650 
DATA W(48), W(49), W(50), W(51), W(52), W(53), W(54), W(55), WAN 1660 
* W(56), W(57), W(58), W(59), W(6@), W(61), W(62), W(63) WAN 167¢ 
*® /.354722132568824D-1, .3705512854024@0D-1, .385501531786156D-1, WAN 168@ 
* .399537411327203D-1, .412625632426235D-1, .424735151236536D-1, WAN 1690 
* ,435837245293235D-1, .445905581637566D-1, .454916279274181D-1, WAN 1700 
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.462847965813144D-1, .46968182816210@D-1, .475401657148303D-1, 
-479993885964583D-1, .483447622348630D-1, .485754674415034D-1, 
-486969579091397D-1/ 

DATA W(64), W(65), W(66), W(67), W(68), W(69), W(76), W(71), 

W(72), W(73), W(74), W(75), W(76), W(77), W(78), W(79) 
/ .44938696029209@D-3, .104581267934035D-2, .164250301866993D-2 
. 22382884 3696262D-2, .283275147145799D-2, .342552604091622D-2, 
- 40162549837 3864D-2, .460458425676296D-2, .519916183267633D-2, 
-57726375428657@D-2, .635166316170719D-2, .692689256689881D-2, 
- 749798192563473D-2, .8964589896486G6D-2, .862637779861675D-2, 
-9183009871669087D-2/ 

DATA W(86), W(81), W(82), W(83), W(84), W(85), W(86), W(87), 
W(88), W(89), W(90), W(91), W(92), W(93), W(94), W(95) 
/.973415341599681D-2, .162794790158322D-1, .168186607395031D-1 
.11351376324¢804D-1, .1187736737274@3D-1, .123961395439569D-1, 
.129075627392673D-1, .134112712886163D-1, .13996964132952¢D-1, 
-1439434590041668D-1, .148731226621473D-1, .153430107688651D-1, 
-158037286593993D-1, .162550009097852D-1, .166965578615892D-1, 
.171281354231114D-1/ 

DATA W(96), W(97), W(98), W(99), W(100), W(1O1), W(1@2), 
W(163), W(104), W(105), W(106), W(107), W(168), W(109), 
W(110), W111), W(112) /.175494758271177D-1, 
-179603271850087D-1, .183604439373313D-1, .187495869405447D-1, 
-191275236099599D-1, .194946280587@66D-1, .1984888123283@9D-1, 
.20191871942130@D-1, .2652279248696@1D-1, .208414477807511D-1, 
-211476464682213D-1, .214412655392@85D-1, .217219495380521D-1, 
-2198971066846@5D-1, .222443288937998D-1, .22485652032745@D-1, 
.227135358502365D-1/ 

DATA W(113), W(114), W(115), W(116), W(117), W(118), W(119), 
W(120), W(121), W(122), wW(123), W(124), W(125), W(126), 
W(127) /.229278441436868D-1, .23128448824387@D-1, 
-233152299940628D-1, .234880760165359D-1, .236468835844476D-1, 
-237915577819034D-1, .239220121367035D-1, .240381686819241D-1, 
-241399579890193D-1, .242273192228152D-1, .243002001679719D-1, 
-2435855726469G6D-1, .244023556338496D-1, .2443156909785@0D-1, 
-244461801962625D-1/ 


DATA W(128), W(129), W(13@), W(131), W(132), W(133), W(134), 


+e FF ee Oe 


* 


+e eee OF 


W(135), W(136), W(137), W(138), W(139), W(14@), W(141), 
W(142) /.112789017822272D-3, .262534944296446D-3, 
-412463254426176D-3, .562348954963141@D-3, .712154163473321D-3, 
.861853701420089D-3, .161142439326844D-2, .116984355756772D-2, 
.13104886819625¢@D-2, .145913733331673D-2, .160796713074933D-2, 
-175655573633073D-2, .199488085349972D-2, .265292022796614D-2, 
.220065164983991D-2/ 

DATA W(143), W(144), W(145), W(146), W(147), W(148), W(149), 
W(156), W(151), W(152), W(153), W(154), W(155), W(156), 
W(157) /.2348905295632731D-2, .249519263470371D-2, 
«264177682542749D-2, .278805532532771D-2, .293391559082972D-2, 
-307933574119934D-2, .32242939617942@D-2, . 336876850731555D-2, 
-351273770505631D-2, .36561799581425@D-2, .379907374876626D-2, 
-394139764149883D-2, .498313028605267D-2, .422425942138154D-2, 
-436473687796806D-2/ 


DATA W(158), W(159), W(160), W(161), W(162), W(163), W(164), 


* 
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W(165), W(166), W(167), W(168), W(169), W(176), W(171), 
W(172) /.45045685814479@D-2, .464372455568006D-2, 
-478218392589269D-2, .491992592181387D-2, .505692988078684D-2, 
-519317525086928D-2, .532864159391593D-2, .546330858864431D-2, 
-559715603368291D-2, .573016385960144D-2, .586231208692265D-2, 
-599358091911534D-2, .612395065556793D-2, .62534017395424@D-2, 
.638191475216788D-2/ 

DATA W(173), W(174), W(175), W(176), W(177), W(178), W(179), 
W(18@), W(181), W(182), W(183), W(184), W(185), W(186), 
W(187) /.650947041505366D~2, .663604959378107D-2, 
-676163330017380D-2, .688626269544632D-2, . 706973969296982D-2, 
-713222396107539D-2, .725363892583391D-2, .737396577381235D-2, 
.749318645486588D-2, . 761128308454566D-2, .772823794738156D-2, 
- 784493349893971D~2, . 795865236875435D-2, .807207736287350D-2, 
-818429146643827D~-2/ 

DATA W(188), W(189), W(19@), W(191), W(192), W(193), W(194), 
W(195), W(196), W(197), W(198), W(199), W(200), W(2@1), 
W(262) /.829527784623523D-2, .840501985322154D-2, 
-851356102502249D-2, .862070508840101D-2, .872661596169881D-2, 
-883121775724875D-2, .893449478375821D-2, .903643154866287D-2, 
.913701276045081D-2, .923622333095630D-2, .933404837762327D-2, 
-943047322573775D-2, .952548341062928D-2, .961906467984073D-2, 
.971126299526628D-2/ 
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171¢ 
172@ 
1730 
1746 
175¢@ 
1760 
1770 
178@ 
1799 
1800 
1819 
1820 
183¢ 
1840 
1850 
1860 
1870 
1880 
1899 
1900 
191¢ 
192¢ 
1930 
1940 
195¢ 
1960 
1970 
198¢ 
199¢ 
2006 
20106 
2020 
2030 
2040 
2050 
2666 
2070 
20680 
2690 
2100 
211¢ 
2126 
2130 
214¢ 
215¢ 
216¢ 
217¢ 
2180 
219¢ 
2200 
221@ 
2220 
2230 
2240 
2256 
2266 
2270 
2280 
229¢ 
2300 
2310 
2320 
2330 
234¢ 
2350 
2360 
2370 
238@ 
2390 
2400 
2410 
242¢ 
2430 
2440 
2456 
2460 
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DATA W(2@3), W(204), W(265), W(206), W(207), W(2@8), W(209), 

* W(210), W(211), W(212), W(213), W(214), W(215), W(216), 

* W(217) /.980188453525733D-2, .989109569669583D-2, 
-997882369703491D-2, . 199650535763064D-1, .101497741990949D-1, 
.192329722564782D—1, .10314635267934@D-1, .1039475909832117D-1, 
-164733073841764D-1, .165502926865815D-1, .106256953418966D-1, 
-196995040389798D-1, .167717077058046D-1, .1¢8422955111148D-1, 
.10911256866049@D-1/ 

DATA W(218), W(219), W(22@), W(221), W(222), W(223), W(224), 
W(225), W(226), W(227), W(228), W(229), W(23), W(231), 
W(232) /.109785814257296D-1, .1164425990998139D-1, 
.111082806090098D-1, .111706345765534D-1, .112313134396497D-1, 
.112993074958755D-1, .113476078955455D-1, .114032060430392D-1, 
.1145769359809G6D-1, .115092624770395D-1, .115597048540436D-1, 
-116684131622531D-1, .116553800949452D-1, .1170059860662067D-1, 
-1174466191406@6D-1/ 

DATA W(233), W(234), W(235), W(236), W(237), W(238), W(239), 

* W(240), W(241), W(242), W(243), W(244), W(245), W(246), 

* W(247) /.117857634973434D-1, .11825697100824¢D-1, 
.118638567340711D-1, .119902366727665D-1, .119348314595636D-1, 
.119676359049959D-1, .119986450878658D-1, .126278543565826D-1, 
.1205525932956@1D-1, .120868558957245D-1, .1210464062153465D-1, 
.121266087205273D-1, .121467581157945D-1, .121650853785355D-1, 
.121815877594818D-1/ 

DATA W(248), W(249), W(25@), W(251), W(252), W(253), W(254), 

* W(255) /.121962627831147D-1, .122091682486372D-1, 

* ,122201222273040D-1, .122293030687103D-1, .122366493950402D-1, 

* ,122421601042728D-1, .122458343697479D-1, .122476716402898D-1/ 
LOOP = MAX@(1,N/256) 

FLOOP = LOOP 
H = (B-A)/FLOOP 
SCALE = H/2.@D@ 
M = MIN@(128,N/2) 
MT = 2%M 
NPLACE = M - 1 
DO 2¢ L=1,LOOP 
FL = L 
AL = A + (FL-1.@D@)*H 
BL = A + FL*H 
K = 256*(L-1) 
DO 1¢ I=1,M 
NPI = NPLACE + IL 
S = T(NPI) 
R = W(NPI)*SCALE 
TleK+I1 
I2=K+MT+ 1-1 
TV(I1) = (AL*(1.DQ+S)+(1.@D@-S)*BL) /2.D@ 
TV(1I2) (AL* (1.D@-S)+(1.@D@+S)*BL) /2.D0 
WV(1l1) = R 
WV(I2) = R 
CONTINUE 
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2@ CONTINUE 


RETURN 
END 


DOUBLE PRECISION FUNCTION RMIN(N, M, COND, UNITRD, AVERR) 


FOR A LINEAR SYSTEM (I-KMM)*XM=RHFCN OF ORDER M, THIS IS THE 
VALUE OF RELMIN USED IN IEGS. THE VARIABLE UNITRD IS DEFINED IN 
IEGAUS, AND THE VARIABLES COND AND AVERR ARE DEFINED IN IEGS 
USING CONEW. 

IT IS UNLIKELY THAT A SOLUTION X CAN BE FOUND FOR THE ORIGINAL 
INTEGRAL EQUATION WITH A SMALLER RELATIVE ERROR THAN RMIN. 


DOUBLE PRECISION FLOAT1, FLOAT2, COND, AVERR, UNITRD, DMAX1 
FLOAT1 = M 

FLOAT2 = M/N 

RMIN = DMAX1((FLOAT1**1.5D@)*COND*UNITRD, (FLOAT2**1 .5D0)* 
* AVERR) 

RETURN 

END 


DOUBLE PRECISION FUNCTION CONEW(COND, ELINSY, RELRSD, AVERR, 
* PASTC, PASTRE) 


WAN 
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C THIS IS USED IN UPDATING THE VALUE OF THE CONDITION NUMBER CON 36 
C IN IEGS. CON 46 
DOUBLE PRECISION COND, ELINSY, RELRSD, AVERR, PASTC, PASTRE, CON 56 

* C, DSQRT, DMAX1 CON 60 
AVERR = DSQRT(ELINSY*PASTRE) CON 76 
PASTRE = ELINSY CON 8@ 

IF (RELRSD.EQ.@.@D@) GO TO 10 CON 90 

C = DMAX1(1.@D@,ELINSY/RELRSD) CON 16¢@ 

CONEW = DSQRT(C*PASTC) CON 11¢@ 

PASTC = C CON 12 
RETURN CON 130 

1@ CONEW = COND CON 146 
RETURN CON 150 

END CON 160 
SUBROUTINE LEAVE(IERSET, NF, MF, XV, TV, WV, ERROR, KERNEL, LEA 10 

* RHFCN, EP, IFLAG, X, T, NT, IER, EPS, ELINSY, TN, WN, TM, LEA 2¢ 

* WM, XM, XMZ, KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, LEA 30 

* NUP, NHALF, XNORM) LEA 46 

C THIS ROUTINE SETS ALL NECESSARY PARAMETERS FOR LEAVING IEGAUS. LEA 5@ 
C IF NT .GT. @, IT ALSO PERFORMS THE NECESSARY NYSTROM LEA 60 
C INTERPOLATION AT THE NODES GIVEN IN T. LEA 7¢ 
DOUBLE PRECISION KERNEL, RHFCN, EP, X, T, XV, TV, WV, ERROR, LEA 80 

* EPS, ELINSY, TN, WN, TM, WM, XM, XMZ, KMM, KMN, KNM, RHS, LEA 9¢ 

* IMKNN, LUFACT, R, RH, DELN, NORMK, R1, R2, FINLEP, SAVEP, LEA 10@ 

* SUM, DERROR, NUMR1, NORM, TEMP, DABS, DMAX1, XNORM LEA 119 
DIMENSION X(1), T(1), XV(MF), TV(MF), WV(MF), TN(NF), WN(NF), LEA 12¢ 

* WM(MF), XM(MF), XMZ(MF), KMM(NUP,NUP), KMN(NUP,NHALF), LEA 13¢@ 

* KNM(NHALF,NUP), RHS(MF), IMKNN(NUP,NUP), LUFACT(NUP,NUP), LEA 14@ 

* R(MF), RH(NF), TM(MF), DELN(NF) LEA 15¢ 
COMMON /INFO/ Rl, R2, FINLEP, NORMK, NFINAL, MFINAL LEA 160 
EXTERNAL KERNEL, RHFCN LEA 17¢ 

C SET ERROR PARAMETERS FOR RETURN. LEA 18¢ 
NORMK = @.@D¢@ LEA 199 
NFINAL = NF LEA 260 
MFINAL = MF LEA 210 
FINLEP = EPS LEA 22¢ 

IF ((EPS.GT.EP) .AND. (ERROR.LE.EPS)) GO TO 1 LEA 230 

IER = IERSET LEA 240 

EP = ERROR LEA 250 

IF (NT.EQ.@) GO TO 20 LEA 260 

GO TO 4¢ LEA 270 

1@ IER = 3 LEA 28@ 

C SINCE EPS IS THE SMALLEST ERROR POSSIBLE, SET EP=EPS FOR THE LEA 290 
C RETURN ERROR ESTIMATE. LEA 36¢ 
EP = EPS LEA 310 

IF (NT.GT.@) GO TO 4¢ LEA 320 

C NO NYSTROM INTERPOLATION IS DESIRED. RETURN THE VALUES AT THE LEA 33¢@ 
C GAUSSIAN NODE POINTS. LEA 34¢ 
2 DO 3@ I=1,MF LEA 350 
X(I) = XV(I) LEA 36¢@ 

T(1) = TV(I) LEA 37¢ 

3@ CONTINUE LEA 380 

NT = MF LEA 390 
RETURN LEA 400 

C CALCULATE NORM(K). LEA 419 
4@ SAVEP = EP LEA 420 

DO 5@ I=1,NF LEA 430 
IMKNN(I,I) = IMKNN(I,I) - 1.@D@ LEA 440 

5@ CONTINUE LEA 450 
NORMK = $.@D0 LEA 460 

DO 7¢ I=1,NF LEA 479 

SUM = 0.@D¢ LEA 48 

DO 6¢ J=1,NF LEA 49¢ 

SUM = SUM + DABS(IMKNN(I,J)) LEA 500 

6@ CONTINUE LEA 510 
NORMK = DMAX1 (NORMK, SUM) LEA 52@ 

76 CONTINUE LEA 530 

DO 8@ I=1,NF LEA 540 
IMKNN(I,1) = IMKNN(I,I) + 1.@D0 LEA 550 

8@ CONTINUE LEA 560 

LF (NF.EQ.MF) GO TO 13¢ LEA 57@ 

C ITERATE TO DECREASE THE NOISE LEVEL IN X. THIS SHOULD REDUCE LEA 589 


C POSSIBLE ERRORS IN NYSTROM INTERPOLATION. LEA 59@ 


COLLECTED ALGORITHMS (cont.) 


DERROR = ((1.@D@-R1) /R1)*EPS/NORMK 
IF (IFLAG.EQ.1) DERROR = DERROR*XNORM 
ITLOOP = @ 
DO 9¢ I=1,MF 
XM(I) = XV(I) 
9 CONTINUE 
16@ DO 11@ I=1,MF 
XMZ(I) = XM(I) 
11@ CONTINUE 
CALL ITERT(KERNEL, RHFCN, NF, TN, WN, MF, TM, WM, XM, XMZ, 
* KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, NHALF, 
* 1) 
NUMR1 = NORM(XM,XMZ,MF, 1) 
ITLOOP = ITLOOP + 1 
IF ((NUMR1.GT.DERROR) .AND. (ITLOOP.LT.5)) GO TO 14@ 
DO 120 I=1,MF 
XV(I) = XM(L) 
12@ CONTINUE 
C ESTIMATE NEW ERROR BOUND FOR NYSTROM INTERPOLATES. 
TEMP = NORMK*(R1/(1.@D@-R1) )*NUMRL 
IF (IFLAG.EQ.1) TEMP = TEMP/XNORM 
EP = DMAX1 (EP, TEMP) 
GO TO 146 
C NO ITERATION USED IN COMPUTING X. JUST COMPUTE ERROR ESTIMATE IN 
C NYSTROM INTERPOLATE. 
13@ TEMP = NORMK*ELINSY 
IF (IFLAG.EQ.0) TEMP = TEMP*XNORM 
IF (IER.NE.2) EP = DMAX1(EP,TEMP) 
C COMPUTE NYSTROM INTERPOLATES AT THE NODES IN T. 
146 DO 16¢@ I=1,NT 
SUM = @.@D¢@ 
DO 15¢ J=1,MF 
SUM = SUM + WV(J)*KERNEL(T(I) ,TV(J))*XV(J) 
15@ CONTINUE 
X(L) = RHFCN(T(1)) + SUM 
16@ CONTINUE 


IF ((IER.EQ.@) .AND. (EP.GT.EPS)) IER = 4 
IF ((IER.EQ.1) .AND. (EP.GT.ERROR)) IER = 5 
IF ((IER.EQ.3) .AND. (EP.GT.EPS)) IER = 6 
EP = SAVEP 

RETURN 

END 


SUBROUTINE INTERP(TM, WM, XM, M, TN, WN, XN, N, KERNEL, 
* RHFCN, RHS, KMN, NHALF, NUP) 
C USE THE VALUES OF XN(I), I=l,...,N, TO CALCULATE THE NYSTROM 
C INTERPOLATES XM(I), I=1,...,M. 
DOUBLE PRECISION KERNEL, RHFCN, TM, WM, XM, TN, WN, XN, RHS, 
* KMN 
DIMENSION TM(M), WM(M), XM(M), TN(N), WN(N), XN(N), RHS(M), 
* KMN (NUP ,NHALF) 
IF (M.GT.NUP) GO TO 6¢@ 
C SINCE M .LE. NUPPER, SAVE K(TM(1),TN(J))=KMN(I,J) AND 
C RHS(1)=RHFCN(TM(I)) FOR LATER USE IN ITERT. 
DO 20 I=1,M 
DO 1¢ J=1,N 
KMN(1I,J) = WN(J)*KERNEL(TM(1) ,TN(J)) 
16 CONTINUE 
2@ CONTINUE 
DO 3¢ I=1,M 
RHS(L) = RHFCN(TM(I)) 
XM(I) = RHS(TI) 
36 CONTINUE 
C CALCULATE NYSTROM INTERPOLATING FORMULA. 
DO 5@ I=1,M 
DO 4¢ J=1,N 
XM(I) = XM(I) + KMN(I,J)*XN(J) 
4@ CONTINUE 
5@ CONTINUE 
RETURN 
C M .GT. NUPPER, SO SAVE JUST RHS(I) FOR LATER USE IN ITERT. 
C CALCULATE NYSTROM INTERPOLATING FORMULA. 
60 DO 8¢@ I=1,M 
RHS(1) = RHFCN(TM(I)) 
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XM(I) = RHS(I) 
DO 7¢ J=1,N 
XM(L) = XM(I) + WN(J)*KERNEL(TM(L) ,TN(J))*XN(J) 
7@ CONTINUE 
8@ CONTINUE 
RETURN 
END 


SUBROUTINE ITERT(KERNEL, RHFCN, N, TN, WN, M, TM, WM, XM, 
* XMZ, KMM, KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, NUP, 
* NHALF, IFLG) 
THIS ROUTINE CALCULATES ONE ITERATE XM GIVEN THE INITIAL GUESS 
XMZ. THE ROUTINE IS DIVIDED ACCORDING TO WHETHER OR NOT 
M .GT. NUPPER. 
DOUBLE PRECISION KERNEL, RHFCN, TN, WN, TM, WM, XM, XMZ, KMM, 
* KMN, KNM, RHS, IMKNN, LUFACT, R, RH, DELN, SUM, DET 
DIMENSION TN(N), WN(N), TM(M), WM(M), XM(M), XMZ(M), 
* KMM(NUP,NUP), KMN(NUP,NHALF), KNM(NHALF,NUP), RHS(M), 
* IMKNN(NUP,NUP), LUFACT(NUP,NUP), R(M), RH(N), DELN(N) 
M .GT. NUPPER MEANS THAT THE MATRICES KMM,KMN,KNM CAN NO LONGER 
BE STORED DUE TO LACK OF SPACE. 
IF (M.GT.NUP) GO TO 120 
IF (IFLG.EQ.1) GO TO 4¢ 
C IF IFLG=@, THEN THE MATRICES KMM AND KNM MUST BE COMPUTED 
Cc AND STORED. 
DO 3¢ J=1,M 
DO 1¢ I=1,M 
KMM(I,J) = WM(J)*KERNEL(TM(I) ,TM(J)) 
1¢ CONTINUE 
DO 2¢ I=1,N 
KNM(I,J) = WM(J)*KERNEL(TN(I),TM(J)) 
2@ CONTINUE 
3@ CONTINUE 
C COMPUTE RESIDUALS R(I)=RHFCN(TM(1I) )-XMZ(1)+KM(TM(L) )*XMZ (I) 
4@ DO 6@ T=1,M 
SUM = $@.@D@ 
DO 5¢@ J=1,M 
SUM = SUM + KMM(I,J)*XMZ(J) 
5@ CONTINUE 
R(L) = RHS(I) - (XMZ(1)-SUM) 
6@ CONTINUE 
C COMPUTE RH=KM*R AT ALL TN(I). 
DO 8¢@ I=1,N 
RH(I) = 9.OD@ 
DO 7@ J=1,M 
RH(I) = RH(1I) + KNM(I,J)*R(J) 
7@ CONTINUE 
8@ CONTINUE 
Cc CALCULATE DELN=((I-KN)**(-1))*KM*R AT ALL TN(I). 
Cc KXKKREKERRAKEREEKEKRREERRKRRRRERRRRRRERRRERRKRRERERRRRKRKRRKR RAK: 
Cc * 
CALL LINSYS(IMKNN, LUFACT, N, RH, DELN, 4, DET, NUP) 


aaa 


aa 


* 
SEE THE ORIGINAL REFERENCE IN IEGS. * 
KKKKKEREKRKEEREREKKRKEERERKRRRREREERERERERERRRERERRRRRERRERREKRRRK RRR 
CALCULATE NEW XM. 
DO 11@ I=1,M 
SUM = 0.@D¢@ 
DO 9% J=1,M 
SUM = SUM + KMM(I,J)*R(J) 
9¢ CONTINUE 
DO 10¢ J=1,N 
SUM = SUM + KMN(I,J)*DELN(J) 
100 CONTINUE 
XM(I) = SUM + R(I) + XMZ(I) 
11¢ CONTINUE 
RETURN 
C ENTRANCE WHEN M .GT. NUP. 
C CALCULATE RESIDUALS. 
126 DO 14@ I=1,M 
SUM = 0.@D0 
DO 136 J=1,M 
SUM = SUM + WM(J)*KERNEL(TM(1) ,TM(J))*XMZ(J) 
136 CONTINUE 


QaAaA4 
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INT 
INT 
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ana 


aaana 


ANQANDQDANQAANMRAAARAAAARAAAARAANAAANANA 


R(I) = RHS(I) - (XMZ(I)-SUM) 
14@ CONTINUE 
CALCULATE RH=KM*R. 

DO 16@ I=1,N 
RH(1) = 6.@D@ 
DO 15@ J=1,M 
RH(I) = RH(1) + WM(J)*KERNEL(TN(1) ,TM(J))*R(J) 

15@ CONTINUE 


16@ CONTINUE 
HAKKKRKERARERKRKERERRERRRERE ERE RR RER ERR RRR RRR RERRREREERERERERREREERE 


* 


CALL LINSYS(IMKNN, LUFACT, N, RH, DELN, 4, DET, NUP) 
k 


SEE THE ORIGINAL REFERENCE IN IEGS. * 
REREKERKKKREREREEKRERERREREREKRRERERERKEKRRERERERRRRRKERERRRRRREKKRERE 
CALCULATE XM. 
DO 19@ I=1,M 
SUM = @.@D@ 
DO 17@ J=1,M 
SUM = SUM + WM(J)*KERNEL(TM(1) , TM(J))*R(J) 
176 CONTINUE 
DO 18@ J=1,N 
SUM = SUM + WN(J)*KERNEL(TM(I) ,TN(J) )*DELN(J) 
186 CONTINUE 
XM(I) = SUM + R(I) + XMZ(I) 
199 CONTINUE 
RETURN 
END 


DOUBLE PRECISION FUNCTION NORM(X, Y, N, IFLAG) 
IFLAG=@ CALCULATE THE MAXIMUM NORM OF X. 
IFLAG=1 CALCULATE THE MAXIMUM NORM OF X-Y. 

DOUBLE PRECISION X, Y, DMAX1, DABS 

DIMENSION X(N), Y(N) 

IF (IFLAG.EQ.1) GO TO 2¢ 
FIND THE NORM OF X. 

NORM = @.@D¢ 

DO 1¢@ I=1,N 

NORM = DMAX1(NORM,DABS(X(I))) 
16 CONTINUE 
RETURN 
FIND THE NORM OF X-Y. 
2@ NORM = 0.@D@ 
DO 3@ I=1,N 
NORM = DMAX1 (NORM, DABS (X(I)-Y(I))) 
3@ CONTINUE 
RETURN 
END 


SUBROUTINE LINSYS(A, D, N, B, X, OPTION, DET, MACHIN) 

SOLVE A*X=B, ORDER(A)=N, DIMENSION OF A=MACHIN. 

OPTION=1 SOLVE A*X=B, LEAVE THE LU DECOMPOSITION A=L*U IN D 

; AND THE PIVOTS IN PIVOT. THE ANSWERS ARE LEFT IN X. 
IT IS PERMISSABLE TO LET B=X AND D=A, BUT THEN THE 
ORIGINAL CONTENTS OF A AND B ARE LOST. 

OPTION=2 CALCULATE DECOMPOSITION A=L*U INCLUDING PIVOTS. SOLVE 
A*X=B, AND THEN CALCULATE THE RESIDUAL AND ONE 
CORRECTION. THE CORRECTIONS ARE LEFT IN R, THE NEW 
VALUE OF Xl IN X, THE RELATIVE ERROR 

NORM (X@-X1) /NORM(X1) 
IN THE VARIABLE ERROR, AND THE RELATIVE RESIDUAL 
NORM (RESIDUAL) /NORM(B) 
IN THE VARIABLE RELRSD. THESE VALUES CAN BE OBTAINED 
USING THE COMMON/LINEAR/ GIVEN BELOW. 

OPTION=3 SAME AS OPTION=1, EXCEPT A=L*U IS KNOWN AND STORED 
IN D. 

OPTION=4 SAME AS OPTION=2, EXCEPT A=L*U IS KNOWN AND STORED 
IN D. 

THE DECOMPOSITION OF A INTO L*U USES SCALED PARTIAL PIVOTING IN 

THE COLUMNS. FOR OPTIONS 1 AND 2, THE DETERMINANT OF A IS 

CALCULATED AND STORED IN DET. IF DET=@, THEN THE ANSWERS ARE 

NONSENSE, D AND X DO NOT CONTAIN USEFUL INFORMATION, AND AND A 
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C AND B ARE LEFT UNDISTURBED (UNLESS D=A OR X=B). LIN 24¢ 
C LINSYS IS PRESENTLY LIMITED TO N .LE. 14%. TO REMOVE THIS LIN 25@ 
C RESTRICTION,CHANGE THE DIMENSION STATEMENT FOR THE ARRAYS R, LIN 260 
C SCALE, AND PIVOT, WHICH ARE GIVEN IN COMMON/LINEAR/. LIN 27 
INTEGER OPTION, PIVOT LIN 28 
DOUBLE PRECISION NORMX, NORME, NORMB, NORMR, A, D, B, X, R, LIN 290 

* SCALE, ERROR, RELRSD, DET, C, TEMP, DMAX1, DABS, SUM LIN 300 
DIMENSION A(MACHIN,MACHIN), D(MACHIN,MACHIN), B(N), X(N) LIN 31¢ 
COMMON /LINEAR/ R(10@), SCALE(1@@), ERROR, RELRSD, PIVOT(1) LIN 32¢ 

ISWIT = 1 LIN 33¢ 

IF (OPTION.GT.2) GO TO 11¢ LIN 346 

C PRODUCE LU DECOMPOSITION OF A AND DET(A) LIN 350 
DET = 0.@D¢ LIN 36¢@ 

DO 2@ I=1,N LIN 376 

DO 10 J=1,N LIN 380 

D(I,J) = A(I,J) LIN 396 

16 CONTINUE LIN 440 

2¢ CONTINUE LIN 416 

C PRODUCE SCALING FACTORS FOR SCALED PARTIAL PIVOTING. LIN 420 
DO 4@ I=1,N LIN 43¢ 
SCALE(I) = @.@D@ LIN 446 

DO 36 J=1,N LIN 45¢ 
SCALE(I) = DMAX1(SCALE(I) ,DABS(D(I,J))) LIN 46¢ 

3@ CONTINUE LIN 470 

IF (SCALE(I).EQ.@.@D@) RETURN LIN 48¢@ 

46 CONTINUE LIN 49¢ 
DET = 1.0D¢ LIN 50@ 
NM1=N- 1 LIN 51¢@ 

C BEGIN GAUSSIAN ELIMINATION. LIN 520 
DO 100 K=1,NM1 LIN 539 

C SELECT PIVOT ROW. LIN 54@ 
C = DABS(D(K,K))/SCALE(K) LIN 55¢ 

INDEX = K LIN 560 

KPl = K+ 1 LIN 570 

DO 5@ I=KP1,N LIN 580 

TEMP = DABS(D(I,K) )/SCALE(I) LIN 590 

IF (TEMP.LE.C) GO TO 5¢@ LIN 6060 

INDEX = I LIN 61¢@ 

C = TEMP LIN 620 

5@ CONTINUE LIN 630 
PIVOT(K) = INDEX LIN 64@ 

IF (INDEX.EQ.K) GO TO 7¢ LIN 650 

C SWITCH ROWS OF D. LIN 660 
DO 6@ J=K,N LIN 670 

TEMP = D(K,J) LIN 6890 

D(K,J) = DCINDEX,J) LIN 69¢ 
D(INDEX,J) = TEMP LIN 700 

66 CONTINUE LIN 71¢ 
TEMP = SCALE(K) LIN 72¢ 
SCALE(K) = SCALE (INDEX) LIN 730 
SCALE(INDEX) = TEMP LIN 74¢ 

DET = -DET LIN 750 

7@ DET = DET*D(K,K) LIN 76 

C ELIMINATE UNKNOWN =K FROM BELOW DIAGONAL IN COLUMN K. LIN 77 
IF (DET.EQ.0.@D@) RETURN LIN 789 

DO 9¢ I=KP1,N LIN 799 

D(I,K) = D(I,K)/D(K,K) LIN 800 

TEMP = D(I,X) LIN 810 

DO 8@ J=KP1,N LIN 820 

D(I,J) = D(I,J) - TEMP*D(K,J) LIN 830 

80 CONTINUE LIN 84 

96 CONTINUE LIN 859 
190 CONTINUE LIN 860 
DET = DET*D(N,N) LIN 87 

IF (DET.EQ.@.@DQ@) RETURN LIN 88@ 

C THE DECOMPOSITION A=P*L*U IS COMPLETE. LIN 89¢ 
C BEGIN SOLUTION OF LINEAR SYSTEM P*L*U*X=B LIN 9@¢ 
C SET R AND X FOR SOLUTION OF A*X=B. LIN 910 
11@ DO 12¢ I=1,N LIN 92¢ 
R(I) = B(I) LIN 93¢ 

X(I) = 0.OD0 LIN 949 

12@ CONTINUE LIN 95@ 
GO TO 1706 LIN 96¢ 

C SET R=B-A*X FOR COMPUTATION OF CORRECTION. LIN 97@ 
130 DO 15@ I=1,N LIN 98¢@ 


SUM = $.@D@ LIN 99@ 
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DO 140 J=1,N LIN 100¢ 

SUM = SUM + A(I,J)*X(J) LIN 1610 

14@ CONTINUE LIN 162 
R(1L) = B(I) - SUM LIN 103¢ 

15@ CONTINUE LIN 1640 
NORMB = @.@D¢ LIN 1950 
NORMR = $.@D¢ LIN 146@ 

DO 16@ I=1,N LIN 1670 
NORMB = DMAX1 (NORMB,DABS(B(I) )) LIN 168@ 
NORMR = DMAX1 (NORMR,DABS(R(I))) LIN 1690 

16¢ CONTINUE LIN 1106¢ 
RELRSD = NORMR/NORMB LIN 111 
ISWIT = 2 LIN 112¢ 

C SOLVE P*L*Z=R AND STORE IN R. LIN 113¢ 
176 NMl = N- 1 LIN 114¢ 
DO 2¢@ K=1,NMI LIN 115¢ 

IF (PIVOT(K).EQ.K) GO TO 18@ LIN 116¢ 

KPIV = PIVOT (K) LIN 117¢ 

TEMP = R(K) LIN 1180 

R(K) = R(KPIV) LIN 119@ 
R(KPIV) = TEMP LIN 12¢¢ 

186 KPl=K+1 LIN 1219 
DO 19@ I=KP1,N LIN 122@ 

R(I) = R(L) - D(I,K)*R(K) LIN 123@ 

199 CONTINUE LIN 124¢ 
20@ CONTINUE LIN 125@ 
C SOLVE U*E=R AND STORE IN R. ALSO LET X=X+E. LIN 126¢ 
R(N) = R(N)/D(N,N) LIN 1270 

GO TO (21¢, 226, 21%, 226), OPTION LIN 1280 

216 X(N) = R(N) LIN 129¢ 
GO TO 23¢ LIN 13¢¢ 

22@ X(N) = X(N) + R(N) LIN 131 
23@ DO 27¢ II=1,NM1 LIN 132@ 
I=N- II LIN 133 

SUM = @.@DO LIN 134@ 
IPl=I+1 LIN 135¢ 

DO 24@ J=IP1,N LIN 136¢ 

SUM = SUM + D(I,J)*R(J) LIN 137@¢ 

246 CONTINUE LIN 138¢ 
R(1) = (R(L)-SUM) /D(I,I1) LIN 139¢ 

GO TO (25@, 260, 250, 260), OPTION LIN 14060 

25@ X(I) = R(I) LIN 1419 
GO TO 27¢ LIN 142¢ 

260 X(I) = X(I) + R(I) LIN 143¢ 
270 CONTINUE LIN 144¢ 
C SOLUTION OF LINEAR SYSTEM IS COMPLETE. RETURN FOR OPTION=1,3. LIN 145 
GO TO (28, 290, 280, 296), OPTION LIN 146¢ 

28@ RETURN LIN 147 
296 GO TO (130, 30), ISWIT LIN 148¢ 
C CALCULATE ERRORS BASED ON CORRECTION. LIN 1499 
30@ NORMX = @.@D@ LIN 15¢6@ 
NORME = @.@D@ LIN 151¢ 

DO 31@ I=1,N LIN 1520 
NORMX = DMAXK1 (NORMX,DABS (X(T) )) LIN 153@ 
NORME = DMAX1 (NORME,DABS(R(I))) LIN 154¢ 

31@ CONTINUE LIN 155¢ 
ERROR = NORME/NORMX LIN 1560 
RETURN LIN 1570 


END LIN 1580 
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GERK: Global Error Estimation for Ordinary 


Differential Equations [D] 


L. F. SHAMPINE and H. A. WATTS 


Sandia Laboratories 


Key Words and Phrases: ordinary differential equations, initial value problems, global 


error estimation, Runge-Kutta-Fehlberg method, Fortran code GERK 
CR Categories: 3.20, 5.17 


Language: Fortran 


DESCRIPTION 


This algorithm is a complement to [1] where the theoretical development is 


described. 


REFERENCES 


1. SHAMPINE, L.F., anp Watts, H.A. Global error estimation for ordinary differential equations. 
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ALGORITHM 


SUBROUTINE GERK(F, NEQN, Y, T, TOUT, RELERR, ABSERR, IFLAG, 
* GERROR, WORK, IWORK) 


FEHLBERG FOURTH(FIFTH) ORDER RUNGE-KUTTA METHOD WITH 
GLOBAL ERROR ASSESSMENT 


WRITTEN BY H.A.WATTS AND L.F.SHAMPINE 
SANDIA LABORATORIES 


GERK IS DESIGNED TO SOLVE SYSTEMS OF DIFFERENTIAL EQUATIONS 
WHEN IT IS IMPORTANT TO HAVE A READILY AVAILABLE GLOBAL ERROR 
ESTIMATE. PARALLEL INTEGRATION IS PERFORMED TO YIELD TWO 
SOLUTIONS ON DIFFERENT MESH SPACINGS AND GLOBAL EXTRAPOLATION 
IS APPLIED TO PROVIDE AN ESTIMATE OF THE GLOBAL ERROR IN THE 
MORE ACCURATE SOLUTION. 


FOR IBM SYSTEM 368 AND 370 AND OTHER MACHINES OF SIMILAR 
ARITHMETIC CHARACTERISTICS, THIS CODE SHOULD BE CONVERTED TO 
DOUBLE PRECISION. 


ABR DNANDDNANANAAANAANA 


CORIO III IK II KK RIK KTR RR IR IK KIKI KI IR TT KITE RII IRATE KICK RK 
C ABSTRACT 
CORR OOII OI IOI IOI IO TOIIO I I OIIOI t tok 
Cc 

Cc SUBROUTINE GERK INTEGRATES A SYSTEM OF NEQN FIRST ORDER 

C ORDINARY DIFFERENTIAL EQUATIONS OF THE FORM 

Cc DY(I)/DT = F(T,Y¥(1),Y¥(2),...,Y(NEQN)) 

Cc WHERE THE Y(I) ARE GIVEN ATT. 

Cc TYPICALLY THE SUBROUTINE IS USED TO INTEGRATE FROM T TO TOUT 

Cc BUT IT CAN BE USED AS A ONE-STEP INTEGRATOR TO ADVANCE THE 

Cc SOLUTION A SINGLE STEP IN THE DIRECTION OF TOUT. ON RETURN, AN 
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ANNAACANAND ANNANANNANNANAARANNNANNANANANANANAMNNANNANANAA 


ESTIMATE OF THE GLOBAL ERROR IN THE SOLUTION AT T IS PROVIDED 
AND THE PARAMETERS IN THE CALL LIST ARE SET FOR CONTINUING THE 
INTEGRATION. THE USER HAS ONLY TO CALL GERK AGAIN (AND PERHAPS 
DEFINE A NEW VALUE FOR TOUT). ACTUALLY, GERK IS MERELY AN 
INTERFACING ROUTINE WHICH ALLOCATES VIRTUAL STORAGE IN THE 
ARRAYS WORK, IWORK AND CALLS SUBROUTINE GERKS FOR THE SOLUTION. 
GERKS IN TURN CALLS SUBKOUTINE FEHL WHICH COMPUTES AN APPROX- 
IMATE SOLUTION OVER ONE STEP. 


GERK USES THE RUNGE-KUTTA-FEHLBERG (4,5) METHOD DESCRIBED 

IN THE REFERENCE 

E.FEHLBERG , LOW-ORDER CLASSICAL RUNGE-KUTTA FORMULAS WITH 
STEPSIZE CONTROL , NASA TR k-315 


THE PARAMETERS REPRESENT- 
F -- SUBROUTINE F(T,Y,YP) TO EVALUATE DERIVATIVES 
YP(I)=DY(I)/DT 
NEQN -- NUMBER OF EQUATIONS TO BE INTEGRATED 


Y¥(*) -- SOLUTION VECTOR AT T 
T -- INDEPENDENT VARIABLE 
TOUT -- OUTPUT POINT AT WHICH SOLUTION IS DESIRED 


RELERR,ABSERR -- RELATIVE AND ABSOLUTE ERROR TOLERANCES FOR 
LOCAL ERROR TEST. AT EACH STEP THE CODE REQUIRES THAT 
ABS(LOCAL ERROR) .LE. RELERR*ABS(Y) + ABSERR 
FORK EACH COMPONENT OF THE LOCAL ERROR AND SOLUTION 
VECTOKS. 
IFLAG -- INDICATOR FOR STATUS OF INTEGRATION 
GERROR(*) -- VECTOR WHICH ESTIMATES THE GLOBAL ERROR AT T. 
THAT IS, GERRGR(I) APPROXIMATES Y(I)-TRUE 
SOLUTION (I). 


WORK(*) -- AKRAY TO HOLD INFORMATION INTERNAL TO GERK WHICH 
IS NECESSARY FOR SUBSEQUENT CALLS. MUST BE DIMENSIONED 
AT LEAST 3+8*NEQN 

IWORK(*) -- INTEGER ARRAY USED TO HOLD INFORMATION INTERNAL 
TO GERKK WHICH IS NECESSARY FOR SUBSEQUENT CALLS. MUST 
BE DIMENSIONED AT LEAST 5 


CER KKKEKEK KKK KKK KEKE KK ERK KKK KEKE K KEK KKK KEK KEE KER EEK KEKE KEK KEKE KKKKEKK KKK 


Cc 


FIRST CALL TO GERK 


CR RKEKKE KKK KKK REE KKK KKK KEKE KKK EEK KEKE KEKE KEEKKEKEKREKEKKEKKEKKEKEKKKES 


ANNAANANANANACAANNAANANAANAAANANAANANNA 


THE USER MUST PROVIDE STORAGE IN HIS CALLING PROGRAM FOR THE 
ARRAYS IN THE CALL LIST - Y(NEQN), WORK(3+8*NEQN), IWORK(5), 
DECLARE F IN AN EXTERNAL STATEMENT, SUPPLY SUBROUTINE F(T,Y,YP) 
AND INITIALIZE THE FOLLOWING PARAMETERS- 


NEQN -- NUMBER OF EQUATIONS TO BE INTEGRATED. (NEQN .GE. 1) 
¥(*) -- VECTOR OF INITIAL CONDITIONS 

T -- STARTING POINT OF INTEGRATION , MUST BE A VARIAELE 
TOUT -- OUTPUT POINT AT WHICH SOLUTION IS DESIRED. 


T=TOUT IS ALLOWED ON THE FIRST CALL ONLY,IN WHICH CASE 
GERK RETURNS WITH IFLAG=2 IF CONTINUATION IS POSSIBLE. 

RELERR,ABSERR -- RELATIVE AND ABSOLUTE LOCAL ERROR TOLERANCES 
WHICH MUST BE NON-NEGATIVE BUT MAY BE CONSTANTS. WE CAN 
USUALLY EXPECT THE GLOBAL ERRORS TO BE SOMEWHAT SMALLER 
THAN THE REQUESTED LOCAL ERROK TOLERANCES. TO AVOID 
LIMITING PRECISION DIFFICULTIES THE CODE ALWAYS USES 
THE LARGER OF RELERR AND AN INTERNAL RELATIVE ERROR 
PARAMETER WHICH IS MACHINE DEPENDENT. 

IFLAG -- +1,-1 INDICATOR TO INITIALIZE THE CODE FOR EACH NEW 
PROBLEM. NORMAL INPUT IS +1. THE USER SHOULD SET IFLAG= 
-1 ONLY WHEN ONE-STEP INTEGRATOR CONTROL IS ESSENTIAL. 
IN THIS CASE, GERK ATTEMPTS TO ADVANCE THE SOLUTION A 
SINGLE STEP IN THE DIRECTION OF TOUT EACH TIME IT IS 
CALLED. SINCE THIS MODE OF OPERATION RESULTS IN EXTRA 
COMPUTING OVERHEAD, IT SHOULD BE AVOIDED UNLESS NEEDED. 


CRRA RK KEK HAKKAR KEKE KERIKERI KEKE KEE KEE KKK EK 


C OUTPUT FROM GERK 
CRI RIKI IKI K ITI TIT I TOIT TTR TTI ITI I IK HEI TAIT IK 


ANANAAANAANANANRARAANDN 


Y¥(*) -- SOLUTION AT T 
T -- LAST POINT REACHED IN INTEGRATION. 
IFLAG = 2 -- INTEGRATION REACHED TOUT. INDICATES SUCCESSFUL 
RETURN AND IS THE NORMAL MODE FOR CONTINUING 
INTEGRATION. 
=-2 -- A SINGLE SUCCESSFUL STEP IN THE DIRECTION OF 


TOUT HAS BEEN TAKEN. NORMAL MODE FOR CONTINUING 
INTEGRATION ONE STEP AT A TIME. 


= 3 -- INTEGRATION WAS NOT COMPLETED BECAUSE MORE THAN 
9008 DERIVATIVE EVALUATIONS WERE NEEDED. THIS 
IS APPROXIMATELY 5808 STEPS. 

= 4 -- INTEGRATION WAS NOT COMPLETED BECAUSE SOLUTION 


VANISHED MAKING A PURE RELATIVE ERROR TEST 


IMPOSSIBLE. MUST USE NON-ZERO ABSERR TO CONTINUE. 


USING THE ONE-STEP INTEGRATION MODE FOR GNE STEP 
IS A GOOD WAY TO PROCEED. 
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Cc = 5 -- INTEGRATION WAS NOT COMPLETED BECAUSE REQUESTED GER 1220 
Cc ACCURACY COULD NOT BE ACHIEVED USING SMALLEST GER 1236 
Cc ALLOWABLE STEPSIZE. USER MUST INCREASE THE ERROR GER 12486 
Cc TOLERANCE BEFORE CONTINUED INTEGRATION CAN BE GER 1258 
Cc ATTEMPTED. GER 1260 
€ = 6 -- GERK IS BEING USED INEFFICIENTLY IN SOLVING GER 1278 
C THIS PROBLEM. TOO MUCH OUTPUT IS RESTRICTING THE GER 1288 
Cc NAT S {SL STEPSIZE CHOICE. USE THE ONE-STEP GER 1298 
Cc INTO WATOR MODE. GER 1300 
Cc = 7 -- INV > INPUT PARAMETERS GER 1310 
C THI. szNDICATOR OCCURS IF ANY OF THE FOLLOWING IS GER 1328 
Cc SATISFIED - NEQN .LE. @ GER 1336 
Cc T=TOUT AND IFLAG .NE. +1 OR -1 GER 1340 
e RELERR OR ABSERR .LT. @. GER 1358 
C IFLAG .EQ. @ OR .LT. -2 OR .GT. 7 GER 1360 
Cc GERROR(*) -- ESTIMATE OF THE GLOBAL ERROR IN THE SOLUTION AT T GER 1370 
Cc WORK (*) , IWORK(*) -- INFORMATION WHICH IS USUALLY OF NO GER 13890 
Cc INTEREST TO THE USEK BUT NECESSARY FOR SUBSEQUENT GER 1390 
Cc CALLS. WORK(1),.. ,WORK(NEQN) CONTAIN THE FIRST GER 14006 
Cc DERIVATIVES OF THE SOLUTION VECTOR Y AT T. GER 1410 
Cc WORK (NEQN+1) CONTAINS THE STEPSIZE H TO BE GER 1420 
C ATTEMPTED ON THE NEXT STEP. IWORK(1) CONTAINS GER 143@ 
Cc THE DERIVATIVE EVALUATION COUNTER. GER 14408 
Cc GER 14598 
Cc GER 1460 
CR KKK KKK KEK KKK KKK KKK KEKE KEK IKK KKK KEKE KEKE ERK KKK EKER EKER EKKKEKKKKKEKKKKK GER 1478 
C SUBSEQUENT CALLS TO GERK GER 1486 
CREEK KKK KKK KEKE KEK KKK RE KEE KKK KEK KEK HERE KEK KEKE RE KEK KEKE KEKKKKEKKEKKKK GER 14908 
Cc GER 1590 
Cc SUBROUTINE GERK RETURNS WITH ALL INFORMATION NEEDED TO CONTINUE GER 1519 
Cc THE INTEGRATION. IF THE INTEGRATION REACHED TOUT, THE USER NEED GER 15286 
Cc ONLY DEFINE A NEW TOUT AND CALL GERK AGAIN. IN THE ONE-STEP GER 1538 
Cc INTEGRATOR MODE (IFLAG=-2) THE USER MUST KEEP IN MIND THAT EACH GER 1540 
Cc STEP TAKEN IS IN THE DIRECTION OF THE CURRENT TOUT. UPON GER 1550 
c REACHING TOUT (INDICATED BY CHANGING IFLAG TO 2), THE USER MUST GER 1568 
Cc THEN DEFINE A NEW TOUT AND RESET IFLAG TO -2 TO CONTINUE IN THE GEn 1570 
C ONE-STEP INTEGRATOR MODE. GER 1580 
Cc GER 1590 
Cc IF THE INTEGRATION WAS NOT COMPLETED BUT THE USER STILL WANTS GER 1608 
Cc TO CONTINUE (IFLAG=3 CASE), HE JUST CALLS GERK AGAIN. THE GER 1618 
c FUNCTION COUNTER IS THEN RESET TO @ AND ANOTHER 9600 FUNCTION GER 16290 
Cc EVALUATIONS ARE ALLOWED. GER 1638 
Cc GER 1646 
Cc HOWEVER, IN THE CASE IFLAG=4, THE USER MUST FIRST ALTER THE GER 1658 
Cc ERROR CRITERION TO USE A POSITIVE VALUE OF ABSERR BEFORE GER 1668 
C INTEGRATION CAN PROCEED. IF HE DOES NOT,EXECUTION IS TERMINATED. GER 1670 
Cc GER 1680 
Cc ALSO, IN THE CASE IFLAG=5, IT IS NECESSARY FOR THE USER TO GER 1696 
C RESET IFLAG TO 2 (OR -2 WHEN THE ONE-STEP INTEGRATION MODE IS GER 1706 
Cc BEING USED) AS WELL AS INCREASING EITHER ABSERR,RELERR OR BOTH GER 1710 
€ BEFORE THE INTEGRATION CAN BE CONTINUED. IF THIS IS NOT DONE, GER 1720 
Cc EXECUTION WILL BE TERMINATED. THE OCCURRENCE OF IFLAG=5 GER 1730 
Cc INDICATES A TROUBLE SPOT (SOLUTION IS CHANGING RAPIDLY, GER 1748 
Cc SINGULARITY MAY BE PRESENT) AND IT OFTEN IS INADVISABLE TO GER 1758 
Cc CONTINUE. GER 1760 
Cc GER 1778 
Cc IF IFLAG=6 IS ENCOUNTERED, THE USER SHOULD USE THE ONE-STEP GER 1788 
Cc INTEGRATION MODE WITH THE STEPSIZE DETERMINED BY THE CODE. IF GER 1790 
Cc THE USER INSISTS UPON CONTINUING THE INTEGRATION WITH GERK IN GER 1800 
C THE INTERVAL MODE, HE MUST RESET IFLAG TO 2 BEFORE CALLING GERK GER 1810 
C AGAIN. OTHERWISE,EXECUTION WILL BE TERMINATED. GER 1820 
Cc GER 1836 
Cc IF IFLAG=7 IS OBTAINED, INTEGRATION CAN NOT BE CONTINUED UNLESS GER 1840 
Cc THE INVALID INPUT PARAMETERS ARE CORRECTED. GER 1858 
Cc GER 1868 
Cc IT SHOULD BE NOTED THAT THE ARRAYS WORK, IWORK CONTAIN GER 1876 
c INFORMATION REQUIRED FOR SUBSEQUENT INTEGRATION. ACCORDINGLY, GER 1880 
C WORK AND IWORK SHOULD NOT BE ALTERED. GER 1890 
Cc GER 1980 
CR RK KIRK KK KKK IKK KKK KKK KEKE REIKI KK KEKE KEE KEKE KEK KEKE EKK KEE GER 191¢ 
C GER 1920 

DIMENSION Y(NEQN), GERRKOR(NBQN), WORK(1), IWORK(5) GER 1938 

EXTERNAL F GEk 1944 
C COMPUTE INDICLS FOk THE SPLITTING OF THE WORK AKRAY GEk 195% 

K1M = NEQN + 1 Le. GER 1968 

Kl = KlmM + 1 GER 1976 

K2 = Kl + NEON GER 1980 

K3 = KZ + NEQN GER 199@ 

KkK4 = K3 + NEQN GER 20086 

K5 = K4 + NEQN GER 2010 

K6 = K5 + NEON GER 2028 

K7 = K6 + NEQN GER 2030 

k& = K7 + NEON GER 2646 
€ KKEKKKKEKKKEKEKKEK KKK KEK KEKK KKK KKK EKER KK KKK KKK KKK EKER KKK KKK KKK KKEKKKKEKKEKEK GER 2358 
Cc THIS INTERFACING ROUTINE MERELY RELIEVES THE USER OF A LONG GER 2060 
Cc CALLING LIST VIA THE SPLITTING APART OF TWO WORKING STORAGE GER 2070 
C ARRAYS. IF VHIS IS NOT COMPATIBLE WITH THE USERS COMPILER, GER 2089 
C HE MUST USE GERKS DIRECTLY. GER 20690 
Cc KKK KRKEKE KKK KKEKKE KEKE KEK KEK KKK KEK KEKE KK KEKE KKKKKKEKKEKKEKKKEKKKKKKKKKEKK GER 2100 

CALL GERKS(F, NEQN, Y, T, TOUT, RELERR, ABSERR, IFLAG, GER 2116 


* GERROK, WOKK(1), WORK(K1M), wORK(K1), WORK(K2), WORK(K3), GER 2128 


COLLECTED ALGORITHMS (cont.) 


AANAANAAGBACACAALCACAANA 


AAAANANAAAN 


AaABAND 


aaaa 


an 


QO 


Q 


o) 


a 


GCG 


an 


Q 


* WORK (K4), WOKK(K5), WORK(K6), WORK(K7), WORK(K8), 

* WORK (K8+1), IWORK(1), IWCRK(Z), IWORK(3), IWORK(4), IWORK(5)) 
RETURN 

END 


SUBROUTINE GERKS(F, NEON, Y, IT, TOUT, RKELERK, ABSERR, IFLAG, 
* GERROkK, YP, H, Fl, F2, F3, F4, F5, YG, YGP, SAVRE, SAVAE, 
* NFE, KOP, INIT, JFLAG, KFLAG) 
FEHLBERG FOURTH(FIFTH) OKkDEK RUNGE-KUTTA METHOD WITH 
GLOBAL EKhOR ASSESSMENT 


KEKE KEKAKKKKKKKKKK KKK KKK KKK KKKKKKKK KK KK KKK KKK KKK KKK KKK KKK 


GERKS INTEGRATES A SYSTEM OF FIKST ORDER ORDINARY DIFFERENTIAL 
EQUATIONS AS DESCRIBED IN THE COMMENTS FOR GERK. THE ARRAYS 
YP,F1,F2Z,F3,F4,F5,YG AND YGP (OF DIMENSION AT LEAST NEQN) AND 
THE VARIABLES H,SAVRE,SAVAE,NFE,KOP,INIT,JFLAG,AND KFLAG ARE 
USED INTERNALLY BY THE CODE AND APPEAR IN THE CALL LIST TO 
ELIMINATE LOCAL RETENTION OF VARIABLES BETWEEN CALLS. 
ACCORDINGLY, THEY SHGULD NOT BE ALTERED. ITEMS OF POSSIBLE 
INTEREST ARE 

YP - DERIVATIVE Of SOLUTION VECTOR AT T 


H - AN APPROPRIATE STEPSIZE TO BE USED FOR THE NEXT STEP 
NFE- COUNTER ON THE NUMBER OF DERIVATIVE FUNCTION 
EVALUATIONS. 


KKKKKEKKEEKKKEEKKEKEKKKKKKKK KKK KKK KK KKK KKKKKKEKKaKKKKKKKKKKKKEKKEEEK 


LOGICAL HFAILD, OUTPUT 

DIMENSION Y(NEQN), YP(NECN), F1(NEQN), F2(NEQN), F3(NEQN), 
* F4(NEOQN), F5(NEQN), YG(NEQN), YGP(NEQN), GERROR(NEQN) 
EXTERNAL F 


RAKE KKK KEKE KKK KEK REE KEEK KEK KKK KKK KEKE KEK EKK EK KKKKKKKKEKKRKAK KKK RK 


ThE COMPUTER UNI‘ ROUNDOFF ERROK U IS THE SMALLEST POSITIVE VALUE 
REPRESENTABLE IN THE MACHINE SUCH THAT 1.+ U .GT. lL. 


VALUES TO BE USED ARE 


U = 9.5E-7 FORK IBM 360/379 

U = 1.5E-6 FCK UNIVAC 1108 

U = 7.5E-9 FOR PDP-18 

U = 7.1E-15 FOR CDC 6006 SERIES 

U = 2.2E-16 FOR IBM 368/378 DOUBLE PRECISION 


DATA U / 


RKKKEKKEKKEKEK KKK EKK KEKE KEK KKK ERK KKK KKK KEE K KEK EEK EKKKKKEKKKKKKKKKKKKKKKKEE 


REMIN IS A TOLERANCE THRESHOLD WHICH IS ALSO DETERMINED BY THE 
INTEGRATION METHOD. IN PARTICULAR, A FIFTH CRDER METHOD WILL 
GENERALLY NOT BE CAPABLE OF DELIVERING ACCURACIES NEAK LIMITING 
PRECISION ON COMPUTERS WI'lH LONG WOKDLENGTHS. 


DATA REMIN /3.E-11/ 


REAR KKK KEK KEE KEKE KEK RIKER KEK KR KEKE KREKKKKKKKKKKKK KK KKK 


THE EXPENSE 1S CONTROLLED BY RESTRICTING THE NUMBER 
OF FUNCTION EVALUATIONS TO BE APPROXIMATELY MAXNFE. 
AS SET,THIS CORRESPONDS TO ABOUT 506 STEPS. 
DATA MAXNFE /9886/ 


KREKKKKKEKRKKERKEK KEKE KEKE K KEE KKK KKK EKKEKKKEEKKEKKKKEKKKKKKKKKKKEKEKKE 


CHECK INPUT PARAMETERS 

IF (NEQN.LT.1) GO TG 19 

IF ((RELERR.LT.@.) .OR. (ABSERR.LT.@.)) GO TO 198 
MFLAG = IAbBS(IFLAG) 

IF ((MFLAG.GE.1) .AND. (MFLAG.LE.7)) GO TO 2@ 


INVALID INPUT 
10 IFLAG = 7 


RETURN 


IS THIS THE FIRST CALL 
20 IF (MFLAG.EQ.1) GO TO 7@ 
CHECK CONTINUALION POSSIBILITIES 


IF (T.EQ.TOUT) GG IG 18 
IF (MFLAG.NE.2) GO TO 38 


IFLAG = +Z OR -2 


IF (INIT.EQ.@) GO TO 66 

IF (KFLAG.EQ.3) GO TO 58 

IF ((KFLAG.EQ.4) .AND. (ABSERR.EQ.@.)) GU TO 48 
IF ((KFLAG.EQ.5) .AND. (RELERK.LE.SAVRE) .AND. 
* (ABSERK.LE.SAVAL)) GO TO 49 

GO TO 78 


IFLAG = 3,4,5,6, OR 7 
36 IF (IFLAG.EQ.3) GO TO 58 


IF ((IFLAG.EQ.4) .AND. (ABSEKR.GT.@.)) GO TO 60 


INTEGRATION CANNOT BE CONTINUED SINCE USER DID NOT RESPUND TO 
THE INSTRUCTIONS PERTAINING 10 IFLAG=4,5,6 OR 7 
4@ STOP 


KRRKKEEKKKKKKKEKKKKEKEKKRKKKEKEKEKKEKKKEKEKKKKKKKKKKK KKK KK KKK KKK KKKK KK KKKEKKE 


RESET FUNCTION EVALUATION COUNTER 


5@ NFE = @ 


IF (MFLAG.EQ.2) GU TO 78 


RESET FLAG VALUE FROM PREVIOUS CALL 

66 IFLAG = JFLAG 
SAVE INPUT IFLAG AND SET CONTINUATION FLAG VALUE FOR SUBSEQUENT 
INPUT CHECKING 

7@ JFLAG = IFLAG 


KFLAG = @ 


SAVE RELEKR AND ABSERR FOK CHECKING INPUT ON SUBSEQUENT CALLS 


SAVRE = RELERK 
SAVAE = ABSERR 


GER 
GER ; 
GER 
GER 
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GER 
GER 
GER 
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COLLECTED ALGORITHMS (cont.) 


Cc 
Cc 
Cc 


AANANNANG 


AAO QO aA Qe 


AGAAaAANL 


KESTRICT RELATIVE ERROR TOLERANCE TO BE AT LEAST AS LARGE AS 
32U+REMIN TO AVOID LIMITING PRECISION DIFFICULTIES ARISING 
FROM IMPOSSIBLE ACCURACY REQUESTS 

KER AMAX1 (RELERR,32.*U+REMIN) 

U26 26.*U 

DT = TOUT - T 

IF (MFLAG.EQ.1) GO 10 84% 

IF (INIT.EQ.9) GO TO 96 


GU TO 116 
ROK TR KIRK RIK RK IKK RIK RIKKI KK IRR KKK KKK RK IKK RRR IKKE KEK KK 
INITIALIZATIGN -- 
SET INITIALIZATION COMPLETION INDICATOR, INIT 
SET INDICATOR FOR 100 MANY OUTPUT POINTS ,KOP 
EVALUATE INITIAL DERIVATIVES 
COPY INITIAL VALUES AND DERIVATIVES FOR THE 
PARALLEL SOLUTION 
SET COUNTER FOK FUNCTIUN EVALUATIONS ,NFE 
ESTIMATE STARTING STEPSIZE 
8@ INIT = @ 
KOP = 6 
A= T 
CALL F(A, Y, YP) 
NEE = 1 
IF (T.NE.TOUT) GO TO 96 
IFLAG = 2 
RETURN 


90 INIT = 1 
H = ABS(DT) 
TCLN = 6G. 
DO 108 K=1,NEQN 
YG(K) = ¥(K) 
YGP(K) = YP(K) 
TOL = KER*ABS(Y(K)) + AbSEREK 
IF (1OL.LE.@.) GO TOC 100 
TOLN = TOL 
YPK = ABS(YP(K)) 
IF (YPK*H**5.GI.TOL) H = (TOL/YPK) **®.2 
108 CONTINUE 
IF (TOLN.LE.@.) H = @. 
H = AMAX1(H,U26*AMAX1 (ABS (T) ,ABS (DT) ) ) 
KKK KKK KKK KKK KEKE KKK KEKE EK KEK KER RE KER KE KKK KKEKKHKEKKKKEKEKRKKKKKKK KKK KKK 
SET STEPSIZE FOR INTEGRATION IN THE DIRECTION FROM T TO TOUT 
11@ H = SIGN(H,DL'L) 
TEST TO SEE IF GERK IS BEING SEVERELY IMPACTED BY TOO MANY 
OUTPUT POINTS 
IF (ABS(H).GT.2.*ABS(DT)) KOP = KOP + 1 
IF (KOP.NE.16¥) GO TO 126 
KOP = @ 
IFLAG = 6 
RETURN 
120 IF (ABS(DI).GI.U26*ABS(T)) GO TO 148 
IF TOO CLOSE TO OUTPUT POINT,EXTRAPOLATE AND RETURN 
DO 13@ K=1,NEQN 
YG(K) = YG(K) + DI*YGP(K) 
Y(K) = Y(K) + DI*YP(K) 
130 CONTINUE 
A = TOUT 
CALL F(A, YG, YGB) 
CALL F(A, Y, YP) 
NFE = NFE + 2 
GO TO 238 
INITIALIZE OUTPUT POINT INDICATOR 
14@ OUTPUT = .FALSE. 
TO AVOID PREMATURE UNDERFLOW IN THE ERROK TOLERANCE FUNCTION, 
SCALE THE ERROR TOLERANCES 
SCALE = 2./RER 
AE = SCALE*ABSERR 
KEK KEKKKKK KEK KKK KKK KKK RK KKK EK KEK KEK KKK KEK KKK KEK EKKKEKKEKKKKKKKK KEKE 
KARKKKKKEK KKK KR KEK KKK EKER KERR KK KK KKK KEE KEKE KKK RKEKKEKKEKKKKKKKK KKK KKK 
STEP BY STEP INTEGRATION 
15@ HFAILD = .FALSE. 
SET SMALLEST ALLOWABLE STEPSIZE 
HMIN = U26*ABS(T) 
ADJUST STEPSIZE IF NECESSARY TC HIT THE OUTPUT POINT. 
LOOK AHEAD TwO STEPS TO AVOID DRASTIC CHANGES IN THE STEPSIZE 
AND THUS LESSEN THE IMPACT OF OUTPUT POINTS ON THE COLE. 
Di = TOUT - £ 
IF (ABS(DT).GE.2.*ABS(H)) GO TO 170 
IF (ABS(DT).GT.ABS(H)) GO TO 16¥ 
THE NEXT SUCCESSFUL STEP wILL COMPLETE THE INTEGRATION TO THE 
OUTPUT POINT 
OUTPUT = .TRUE. 
H = DY? 
GO TO 179 
169 A = 6.5*DT 
KRRAEKKEKKKHEKRKEKK EKER KKK RE KK KEK KKK KEK KEKE KKK RKKKKEKKKKKKKKKKKKKK KEKE 
CORE INVEGRATOR FOR TAKING A SINGLE STEP 
KKK KKEKKE KEK KEK KK KEKE KKK KKK KEKE KEKE KKK KEKE KEK KEKKKEKKEKKKKKHEKKEKKAKKKKEKKEKE 
THE TOLERANCES HAVE BEEN SCALED TO AVOID PREMATURE UNDERFLOW 
IN COMPULING ThE ERKOK TOLERANCE FUNCYION ET. 
TO AVOID PRUBLEMS WITH ZERO CROSSINGS, RELATIVE ERROR IS 
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858 

868 

870 

88@ 

690 

900 

91¢ 

920 

936 

946 

950 

960 

970 

980 

999 
1000 
10160 
1620 
1030 
12040 
1450 
1666 
1078 
1086 
1098 
1168 
1116 
1128 
1130 
1146 
1158 
116@ 
1176 
1188 
1198 
12008 
1218 
1220 
1230 
1240 
1250 
1268 
1270 
12890 
1290 
1306 
1318 
1320 
1338 
1346 
1356 
1368 
1376 
1386 
1396 
1400 
1418 
1420 
1430 
1448 
1450 
1466 
1470 
1488 
1492 
1568 
15198 
1526 
1536 
154¢@ 
1550 
1560 
1579 
1580 
1590 
1688 
1618 
16208 
1639 
1640 
1650 
1666 
1670 
1680 
L696 
1706 
1718 
1720 
1738 
1740 
1756 
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COLLECTED ALGORITHMS (cont.) 


(o) aaqannaacannnananaananacaaa 


oO 


GaAaaa 


om eone) 


ozone) 


ANAG 


MLASURED USING THE AVEKAGE OF ‘HE MAGNITUDES OF THE SGLUTION 
AT THE BEGINNING AND END OF A STEP. 
THE ERROR ESTIMATE FORMULA HAS BEEN GROUPED TO CONTROL LOSS CF 
SIGNIFICANCE. 
TO DISTINGUISH THE VARIOUS ARGUMENTS, H IS NOT PERMITTED 
TO BECOME SMALLER THAN 26 UNITS OF KOUNDOFF IN T. 
PRACTICAL LIMITS ON THE CHANGE IN THE STEPSIZE ARE ENFORCED TO 
SMOOTH THE STEPSIZE SELECTION PROCESS ANL TO AVOID EXCESSIVE 
CHATTERING ON PROBLEMS HAVING DISCONTINUITIES. 
TO PREVENT UNNECESSARY FAILURES, THE CCDE USES 9/16 THE 
STEPSIZE IT ESTIMATES wILL SUCCEED. 
AFTER A STEP FAILURE, THE STEPSIZE IS NOT ALLOWED TO INCREASE 
FOR THE NEXT ATTEMPTED STEP. ‘HIS MAKES THE CODE MORE 
EFFICIENT ON PRKOBLEMS HAVING DISCONTINUITIES AND MORE 
EFFECTIVE IN GENERAL SINCE LOCAL EXTRAPOLATION IS BEING USED 
AND THE ERROR ESTIMATE MAY BE UNRELIABLE OR UNACCEPTABLE WHEN 
A STEP FAILS. 
FORK KK KI KKK KKK RK KO KK KK KIRK KR KKK KIRK KK KKK KERR KKK EKA K KKK 
TEST NOMBEK OF DERIVATIVE FUNCTION EVALUATIONS. 
IF OKAY,TRY TO ADVANCE THE INTEGRATION FROM T TO T+H 
17@ IF (NFE.LE.MAXNFE) GO TO 18¥ 
TOG MUCH WORK 
IFLAG = 3 
KFLAG = 3 
KE'TURN 
ADVANCE AN APPKOXIMATE SOLUTION OVER ONE STEP OF LENGTH H 
18@ CALL FEHL(F, NEQN, YG, T, H, YGP, Fl, F2, F3, F4, F5, 
NFE = NFE + 5 
COMPUTE AND TEST ALLOWABLE TOLERANCES VERSUS LOCAL ERROR 
ESTIMATES AND REMOVE SCALING OF TOLERANCES. NOTE THAT RELATIVE 
ERROR IS MEASURED WITH RESPECT TO THE AVERAGE MAGNITUDES OF THE 
OF THE SOLUTION AT THE BEGINNING AND END OF THE STEP. 


Fl) 


EEOET = @. 
DO 200 K=1,NEQN 
ET = ABS(YG(K)) + ABS(F1(K)) + AE 


IF (ET.GT.@.) GO TO 198 
INAPPROPRIATE ERROR TOLERANCE 


IFLAG = 4 
KFLAG = 4 
RETURN 
198 EE = ABS((-2090.*YGP(K)+(21970.*F3(K)-15048.*F4(K))) 


* +(22528.*F2(K)-27360.*F5(K))) 


EEOET = AMAX1 (EECET,EE/ET) 
200 CONTINUE 
ESTIOL = ABS (H) *EEGLT*SCALE/752460. 


IF (ESTIOL.LE.1.) 
UNSUCCESSFUL STEP 
REDUCE THE STEPSIZE , TRY AGAIN 
THE DECREASE IS LIMITED TO A FACTOR OF 1/190 


GO TO 218 


HFAILD = .TRUE. 

OUTPUT = .FALSE. 

S = @.1 

IF (ESTIOL.LT.59049.) S = @.9/ESTTOL**9.2 
H = S*H 


IF (ABS (H).GT.HMIN) GO TO 178 
REQUESTED ERROR UNATTAINABLE AT SMALLEST ALLOWABLE STEPSIZE 


IFLAG = 5 
KFLAG = 5 
RETURN 


SUCCESSFUL S1EP 
STORE ONE-STEP SOLUTION YG AT T+H 
AND EVALUATE DERIVATIVES THEKE 
210 TS = T 
T= +H 
DG 226 kK=1,NEON 
YG(K) = F1(K) 
CONTINUE 
A= T 
CALL F(A, YG, 
NF& = NFE + 1 
NOW ADVANCE THE Y SOLUTION OVER TwO STEPS UF 
LENGTH H/2 AND EVALUATE DERIVATIVES THERE 


220 


YGF) 


HH = @.5*H 

CALL FERL(F, NEQN, Y, TS, HH, YP, Fl, F2, F3, E4, F5, Y) 
TS = TS + HH 

A= TS 

CALL F(A, Y, YP) 

CALL FLHL(F, NEQN, Y, TS, HH, ¥P, Fl, F2, F3, F4, FS, Y) 
A= T 

CALL F(A, Y, YP) 

NFE = NEE + 12 


CHOOSE NEXT STEPSIZE 
THE INCREASE IS LIMITED TO A FACTOR OCF 5 
IF STEP FAILURE HAS JUST OCCURRED, NEXT 
STEPSIZE IS NOT ALLOWED TO INCKEASE 
S = 5. 
IF (ESTTOL.GT.1.689568E-4) S = 
IF (HFAILD) S = AMINI(S,1.) 
H = SIGN(AMAX1(S*ABS(H) ,HMIN) ,H) 
FORK III RIK IO RRR KK KIRK RRR KKK KKK RK KKK KK KERR KK ERK KKK KKK 


END OF CGRE INTEGRATOR 


@.9/ESTIOL**9. 2 
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1768 
1770 
178 
1798 
1886 
1819 
1828 
1839 
1840 
18590 
1860 
1870 
1888 
1890 
1906 
1910 
19208 
19390 
1946 
1950 
1968 
1970 
1980 
1990 
20808 
20198 
2420 
2830 
2848 
2050 
2260 
2270 
2280 
2090 
21088 
211% 
2120 
2130 
21408 
2156 
2160 
217@ 
2186 
2190 
22608 
2218 
2220 
2236 
2240 
2258 
2268 
2276 
2280 
2296 
2300 
2310 
2328 
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2346 
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2360 
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2380 
2398 
2466 
2416 
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2488 
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2558 
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2598 
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COLLECTED ALGORITHMS (cont.) 


Cc 
Cc 


aAaAAN 


AaOCCCOCNKHO Aan oAcennao 


KKK KK KKK KKK KR KEK KKK KICK KK KK KKK KKK IKK KEE KEK KEIR KEK KKK KKK KKK KEKE KEKKKK KEE 


SHGULD WE TAKE ANOTHER STEP 
IF (OUTPUT) GO TO 239 
IF (IFLAG.GT.@) GO TO 150 


SECC CCC Ce TCC CTC CTE PT CCCCCCCCSCCCCCCSOSCSCSCSC CSCC CCL CSCS See eS 
TEEtetteCCCCCCCCCCCCCCCOCTCCCCOCC CCC CSCS SSS SSCS CTC eee SSS SS SS 
INTEGRATION SUCCESSFULLY COMPLETED 
ONE-STEP MODE 
IFLAG = -2 
GO TO 240 
INTERVAL MODE 
2360 T = TOUT 
IFLAG = 2 
240 DO 250 k=1,NEQN 
GERROR(K) = (¥G(K)-Y¥(K))/31. 
250 CONTINUE 
RETURN 
END 


SUBROUTINE FEHL(F, NEQN, Y, T, H, YP, Fl, F2, F3, F4, FS, S) 
FEHLBERG FOURTH-FIFTH ORDEK RUNGE-KUTTA METHOD 
KKRKKKKEKKKKKEKEKEKEK KKK KEKEKRE KK KKK KEKE KEKE KK KKK EKKKE KEE KEK KKKEKEKKKRKKKAKKEKEKE 
FEHL INTEGRATES A SYSTEM OF NEQN FIRST ORDER 
ORDINARY DIFFERENTIAL EQUATIONS OF THE FORM 
DY (I) /DT=F(T,¥(1) ,---,Y(NEQN) ) 
WHERE THE INITIAL VALUES Y(I) AND THE INITIAL DERIVATIVES 
YP(I) ARE SPECIFIED AT THE STARTING POINT T. FEHL ADVANCES 
THE SOLUTION OVER THE FIXED STEP H AND RETURNS 
THE FIFTH ORDER (SIXTH ORDEK ACCURATE LOCALLY) SOLUTION 
APPROXIMATION AT T+H IN ARRAY S(I). 
Fl,---,F5 AkE AKRAYS OF DIMENSION NEQN WHICH ARE NEEDED 
FOR INTERNAL S'LORAGE. 
THE FORMULAS HAVE BEEN GROUPED TO CONTROL LOSS OF SIGNIFICANCE. 
FEHL SHOULD BE CALLED WITH AN H NUT SMALLER THAN 13 UNITS CF 
ROUNDOFF IN T SO THAT THE VAkKIOUS INDEPENDENT ARGUMENTS CAN BE 
DISTINGUISHED. 
KHEKKKKKKKHKEKAKKKEEKKEKREKEKKEKERKE KK KE KKK KEKE KEKE KKK KEKE KKKKKKKKKKKKKK 
DIMENSION Y(NEQN), YP(NEQN), F1(NEQN), F2(NEQN), F3(NEQN), 
* P4(NEQN), F5(NEQN), S(NEQN) 
CH = @.25*H 
DO 1@ K=1,NEQN 
F5(K) = ¥(K) + CH*YP(K) 
1@ CONTINUE 
CALL F(T+0.25*H, F5, Fl) 
CH = @.09375*H 
DO 29 K=1,NEQN 
F5(K) = ¥(K) + CH*(YP(K)+3.*F1(K)) 
20 CONTINUE 
CALL F(T+@.375*H, FS, F2) 
CH = H/2197. 
DO 3@ K=1,NEQN 
F5(K) = ¥(K) + CH*(1932.*¥YP(K)+(7296.*F2(K)-7200.*F1(K))) 
38 CONTINUE 
CALL F(1+12./13.*H, F5, F3) 
CH = H/41@4. 
DO 40 K=1,NEQN 
F5(K) = Y¥(K) + CH*((8341.*YP(K)-845.*F3(K))+(29440.*F2(K) 
*  -32832.*F1(K))) 
49 CONTINUE 
CALL F(T+H, F5, F4) 
CH = H/20520. 
DU 58 K=1,NEQN 
F1(K) = ¥(K) + CH*((-6086.*YP(K)+(9295.*F3(K)-5643.*F4(K))) 
* +(41040.*E1(K)-28352.*F2(K))) 
5@ CONTINUE 
CALL F(T+08.5*H, Fl, FS) 


C COMPUTE APPROXIMATE SOLUTION AT T+H 


CH = H/7618058. 
DG 66 K=1,NEQN 
S(K) = ¥(K) + CH*((982860.*YP(K)+(3855735.*F3(K)-1371249.* 
* F4(K)))+(3953664.*F2(K)+277020.*F5(K))) 
68 CONTINUE 
RETURN 
END 
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AIGORITHM 505 | 
A List Insertion Sort for Keys With Arbitrary 
Key Distribution [$20] 


WOLFGANG JANKO 
Hochschule fir Welthandel, Austria 


Key Words and Phrases: sorting, searching, linked lists, lists, insertion 
CR Categories: 5.31, 4.49, 3.74 
Language: Basic Fortran 


DESCRIPTION 


The description of this algorithm, the experimental results, and the references are 
given in the author’s paper, ‘‘A List Insertion Sort for Keys With Arbitrary Key 
Distribution,” ACM Trans. Math. Software 2, 2(June 1976), 143-153. 


ALGORITHM 
SUBROUTINE SPN(K, L, II, JJ, MIN) SPN 10 
Cc **SAMPLE SEARCH SORT** SPN 20 
C A LIST INSERTION SORT TO BUILD UP A SINGLE CIRCULARLY SPN 30 
C LINKED LIST. SPN 40 
C THIS ALGORITHM SORTS THE KEYS K(II),K(II+1),...,K(JJd) IN SPN 50 
C ASCENDING SORTING ORDER BY THE MEANS OF THE POINTER FIELDS SPN 60 
C L(II),L(II+1),....,L(JJ). SPN 70 
C THE EXPECTED NUMBER OF NECESSARY COMPARISIONS AND SPN 80 
C ACCESSES IS.OF ORDER N**1.5 (N=JJ-II+1). SPN 90 
C WITH SINGLE KEYS THE ALGORITHM IS PROPORTIONAL IN SORTING SPN 100 
C TIME TO A SHELL SORT ALGORITHM. SPN 110 
C ISTRT AUXILIARY VARIABLE IN RANDOM SEARCH SPN 120 
C K ARRAY OF N KEYS. SPN 130 
cL ARRAY FOR N POINTERS. SPN 140 
C IPOI VARIABLE WHICH IS USED TO MANIPULATE POINTERS. SPN 150 
C KDIFF DISTANCE OF THE KEY FOUND IN RANDOM SEARCH SPN 160 
Cc AND THE KEY WHICH SHALL BE INSERTED. SPN 170 
C KEY,MADIN ‘ADDRESSES USED IN SEQUENTIAL AND RANDOM SEARCH. SPN 180 
C MAX,MIN VARIABLES TO STORE THE ADDRESS OF THE SPN 190 
Cc KEYS WITH THE SMALLEST AND LARGEST VALUE. SPN 200 
CN NUMBER OF KEYS. SPN 210 
C IrRT STEP WIDTH IN RANDOM SEARCH. SPN 220 
C TAB ARRAY OF VALUES WHICH DETERMINES THE SAMPLE SIZE. SPN 230 
C THE ALGORITHM IS STABLE. SPN 240 
C MIN RETURNS THE ADDRESS OF THE FIRST RECORD IN SORTING SPN 250 
C ORDER OF THE LIST. SPN 260 
INTEGER TAB(57) SPN 270 
DIMENSION K(1), L(1) SPN 280 
DATA TAB(1), TAB(2), TAB(3), TAB(4), TAB(5), TAB(6), TAB(7), SPN 290 
* TAB(8), TAB(9), TAB(10), TAB(11), TAB(12), TAB(13), TAB(14), SPN 300 
* TAB(15), TAB(16), TAB(17), TAB(18), TAB(19), TAB(20), SPN 310 
* TAB(21), TAB(22), TAB(23), TAB(24), TAB(25), TAB(26), SPN 320 
* TAB(27), TAB(28), TAB(29), TAB(30), TAB(31), TAB(32), SPN 330 
* TAB(33), TAB(34), TAB(35), TAB(36), TAB(37), TAB(38), SPN 340 
* TAB(39), TAB(40), TAB(41), TAB(42), TAB(43), TAB(44), SPN 350 
* TAB(45), TAB(46), TAB(47), TAB(48), TAB(49), TAB(50), SPN 360 


Received 2 July 1974. 
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TAB(51), TAB(52), TAB(53), TAB(54), TAB(55), TAB(56), 
TAB(57) /3,5,10,17,26,37,50,65,82,101,122,145,170,197,226, 


962,1025,1090,1157,1226,1297,1370,1445,1522,1601,1682,1765, 


* 
* 
* 257,290,325,362,401,442,485,530,577,626,677,730,785,842,901, 
* 
* 1850,1937,2026,2117,2210,2305,2402,2501,2602,2705,2810,2917, 


* 3026,3137,3250/ 


INITIALISATION (PART I) 
MIN = II 
MAX = II 
L(II) = II 
IF (JJ-II) 170, 170, 10 
10 KMIN = K(MIN) 
KMAX = KMIN 
TA. =" 11-¢ 1 
IRT = 1 
ITAB = TAB(1) + II - 1 
ISTRT = II 


INSERTION LOOP (PART ITI) 
DO 160 J=IA,JJ 

CORRECTION OF THE SAMPLE SIZE (IF NECESSARY) 
IF (J-ITAB) 30, 20, 20 

20 IRT = IRT + 1 
ISTRT = ISTRT + 1 
ITAB = TAB(IRT) + II - 1 

30 KJ K(J) 

PROVISION FORK ARISING LARGEST AND SMALLEST KEYS (1). 
IF (KJ-KMAX) 46, 68, 680 


40 IF (KJ-KMIN) 70, 508, 90 


it 


KEY WHICH SHALL BE INSERTED IS EQUAL TO THE MINIMAL 
KEY SORTED SO FAR (2). 
58 MADIN = MIN 

MIN = J 

GO TO 138 
KEY WHICH SHALL BE INSERTED IS EQUAL TO OR LARGER THAN THE 
MAXIMAL KEY SORTED SO FAR (3). 
60 I = MAX 

MAX = J 

KMAX = K(J) 

GO TO 88 


KEY FOR INSERTION IS SMALLER THAN THE SMALLEST KEY SORTED 


SO FAR (4). 

70 I = MAX 
MIN = J 
KMIN = K(J) 


INSERTION OF THE RECORD AND CORRECTION OF THE VALUE WHICH 


DETERMINES THE SAMPLE SIZE (5). 
88 IPOI = L(I) 

L(I) = J 

L(J) = IPOI 

GO TO 166 


INITIALISATION FOR RANDOM SEARCH (FIRST STEP) (6). 


IPOI = J - 1 


ww ww ew we ew ee ww ow a we a ww a i a ww ww ww ee a we ewe ee ewe ee ww 


RANDOM SEARCH (7). 
PART 1 (7A). 


DO 12@ KEY=ISTRI,IPOI,IRT 
KDIFF = KJ - K(KEY) 
IF (KDIFF) 128, 148, 188 


eo ee we wee we we ee a we ww we ee owe ee ee we ew ee ee we ee ee we we wwe we ee ee ee = 


180 IF (I-KDIFF) 126, 126, 1190 


aw ew ee we ee we ww ee ee ewe ewe ew me ew ee eee wm ew ee www we ee wwe em wee eee eo 


PART 2.. STORE NEAREST KEY FOUND SO FAR (7B) 


118 I = KDIFF 


SEQUENTIAL SEARCH (8). 


1390 IPOI = MADIN 
MADIN = L(IPOT) 
IF (KJ-K(MADIN)) 150, 138, 138 


SPN 
SPN 


668 
&76 
&8 
696 
988 
910 
920 
930 
946 
958 
966 
976 
980 
998 
1208 
1018 
1026 
1038 
1248 
1@58 
1868 
1078 
1280 
1298 
1108 
1118 
1128 
1138 
1148 
1150 
1168 
1178 
1180 
1198 
1206 
1210 
1220 
1238 
1240 
1258 
12686 
1276 
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148 MADIN = KEY 
GO TO 138 


15@ L(IPOI) = Jd 


L(J) 


170 MIN = 
L (MAX) 
RETURN 
END 


= MADIN 


L (MAX) 
= 0 
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SPN 
SPN 
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ALGORITHM 506 

HQR3 and EXCHNG: Fortran Subroutines for 
Calculating and Ordering the Eigenvalues of a 
Real Upper Hessenberg Matrix | F2| 


G. W. STEWART 
University of Maryland 


Key Words and Phrases: eigenvalue, QR-algorithm 
CR Categories: 5.14 
Language: Fortran 


DESCRIPTION 


1. Usage 


HQR3 isa Fortran subroutine to reduce a real upper Hessenberg matrix A to quasi- 
triangular form B by a unitary similarity transformation U: 


B = UTAU. 
The diagonal of B consists of 1X1 and 2X2 blocks as illustrated below: 


xX X X X X X 
O x x x x x 
QO x x x x x 
000x x x 
0000 x x 
0000 x x 


The 1X1 blocks contain the real eigenvalues of A, and the 2X2 blocks contain 
the complex eigenvalues, a conjugate pair to each block. The blocks are ordered so 
that the eigenvalues appear in descending order of absolute value along the diag- 
onal. The transformation U is postmultiplied into an array V, which presumably 
contains earlier transformations performed on A. 

The decomposition produced by HQR3 differs from the one produced by the 
EISPACK subroutine HQR2 [2] in that the eigenvalues of the final quasi-triangular 
matrix are ordered. This ordering makes the decomposition essentially unique, 
which is important in some applications (e.g. see [4]). It should also be noted that 
when the eigenvalues \;, \2,..., An Of A are ordered so that || > [Ax] >--- > 
| An |, and if | A;| > | Asa |, then the first 7 columns of U form an orthonormal basis 
for the invariant subspace corresponding to \1, \2,..., A:- In applications where 
it is desired to work with the matrix A in such a dominant invariant subspace, 


— 
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HQR3 provides a convenient means for calculating a basis. The corresponding 
leading principal submatrix of B is a representation of A in that subspace. When 
an ordered quasi-triangular form is not required, the EJSPACK program HQR2 
will be slightly more efficient than HQR3. 

The calling sequence for HQR3 is: 


CALL HQR3 (A,V,N,NLOW,NUP,EPS,ER,ELTYPE,NA NV) 
with (parameters preceded by an asterisk are altered by the subroutine): 


*A A doubly subscripted real array containing the matrix to be reduced. On return, 
A contains the final quasi-triangular matrix. The elements of the array below the 
third subdiagonal are unaltered by the subroutine. 


*V A doubly subscripted real array into which the reducing transformation is postmul- 
tiplied. 
N An integer containing the order of A and V. 


eee Integers prescribing what part of A is to be reduced. Specifically 
A(NLOW,NLOW-—1) and A(NUP+1,NUP) are assumed zero and only the block 
from NLOW through NUP is reduced. However, the transformation is performed 
on all of the matrix A so that the final result is similar to A. 
EPS Convergence criterion. Maximal accuracy will be attained if EPS is set to 6~¢, 
where @ is the base of the floating-point word and ¢ is the length of its fraction. 
Smaller values of EPS will increase the amount of work without significantly im- 
proving the accuracy. 
*ER A singly subscripted real array containing the real parts of the eigenvalues. 
*EI A singly subscripted real array containing the imaginary parts of the eigenvalues. 
*TYPE A singly subscripted integer array whose ith entry is: 
0 if the 7th eigenvalue is real; 
1 if the 2th eigenvalue is complex with positive imaginary part; 
2 if the 7th eigenvalue is complex with negative imaginary part; 
--1 if the 7th eigenvalue was not successfully calculated. 
The entry 1 is always followed by a 2. Only elements NLOW through NUP of ER, 
EI, and TYPE are set by HQR3. 
NA The first dimension of the array A. 
NV The first dimension of the array V. 


HQR3 can be used together with the EISPACK programs ORTHES and 
ORTRAN [2] to reduce a full matrix A to quasi-triangular form with the eigen- 
values appearing in descending order of absolute value along the diagnonal, 


CALL ORTHES(NA,N,NLOW,NUP,A,P) 
CALL ORTRAN(NA,N,NLOW,NUP,A,P,V) 
CALL HQR3(A,V,N,NLOW,NUP,EPS,ER,EI,TYPE,NA,NA) 


where P is a singly subscripted scratch array of order N. 

HQRK3 requires the subroutines EXCHNG, SPLIT, and QRSTEP. 

EXCHNG is a Fortran subroutine to interchange consecutive 1X1 and 2X2 
blocks of an upper Hessenberg matrix. Specifically it is supposed that the upper 
Hessenberg matrix A has a block of order 61 starting at the Ith diagonal element 
and a block of order 62 starting at the (J + b1)-th diagonal element (illustrated 
below for n = 5,1 = 2, b1 = 2,62 = 1): 


d 
x xX xX x x 
1o%x.xxx 
O x x x x 
0 00x x 
0000 x 


EXCHNG produces an orthogonal similarity transformation W such that WTAW 
has consecutive blocks of order 62 and 61 starting at the /th diagonal element (il- 
lustrated from the example above): 


coco x 
ooox*x RS 
On MM MM 
Om MM 
mM OM OM 
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The eigenvalues associated with each block are interchanged along with the blocks. 
The transformation W is postmultiplied into the matrix V. 

EXCHNG can be used to rearrange the blocks of the quasi-triangular matrix 
produced by HQR3. For example, one might wish to cluster a group of nearly equal 
eigenvalues at the top of the matrix before applying a deflation technique to un- 
couple them from the rest of the problem. 

The calling sequence for EXCHNG is: 


CALL EXCHNG(A,V,N,L,B1,B2,EPS,FAIL,NB,NV) 
with (parameters preceded by an asterisk are altered by the subroutine): 


*A A doubly subscripted real array containing the matrix whose blocks are to be in- 
terchanged. Only rows and columns L through L + B1 + B2 — 1 are transformed. 
Elements of the array A below the third subdiagonal are not altered. 


*V A doubly subscripted array containing the matrix V into which the reducing transfor- 
mation is to be accumulated. Only columns L through L + Bl + B2 — 1 are altered. 

N An integer containing the order of A and V. 

L An integer containing the leading diagonal position of the blocks. 

Bl An integer containing the size of the first block. 

B2 An integer containing the size of the second block. 


EPS A convergence criterion (cf. EPS in the calling sequence for HQR3). 

*FAIL A logical variable that on normal return is false. If the iteration to interchange the 
blocks failed, it is set to true. 

NA The first dimension of the array A. 

NV The first dimension of the array V. 


By repeated applications of EXCHNG the eigenvalues of a quasi-triangular matrix 
can be arranged in any desired order. 
EXCHNG requires the subroutine QRSTEP. 


2. Method and Programming Details 


HQR3 uses the implicit double-shift QR algorithm to reduce A to quasi-triangular 
form (for the theoretical background see [8, 5]). The program is essentially a 
Fortran variant of part of the Algol program hgr2 in the Numerische Mathematik 
handbook series {1] with these differences: 

(1) The calling sequence is somewhat different. 

(2) Eigenvectors are not computed. 

(3) The parameters NLOW and NUP are not comparable to the parameters 
low and upp of hqr2. Specifically, in HQR3 rows 1 through N of V are transformed; 
whereas in hqr2 only rows low through upp are transformed. 

(4) The code that performs the QR iterations in hgr2 is replaced by a call to the 
subroutine QRSTEP. 

(5) After a 1X1 or 2X2 block has been isolated, the subroutine EXCHNG is 
used to position it correctly among the previously isolated blocks. It should be 
realized that EXCHNG is a numerical algorithm and may change an ill-conditioned 
eigenvalue in a block significantly. This means that after interchanging two blocks 
with ill-conditioned eigenvalues that are very nearly equal in absolute value, the 
eigenvalues may still not be in descending order of absolute value. Since numer- 
ically the absolute values of these eigenvalues cannot be told apart, this phenome- 
non is not of much importance. 

The convergence criterion is the same for both programs. A subdiagonal element 
A(I+ 1,1) is regarded as negligible it it is less than or equal to 
EPS * (ABS(A(I, I)) + ABS(A(I + 1,1 + 1))). If 10 or 20 iterations are per- 
formed without convergence, an ad hoc shift is introduced to break up any cycling. 
If 30 iterations are performed without convergence, the subroutine gives up. Al- 
though when this happens the matrix returned is not quasi-triangular, it is still 
almost exactly similar to the original matrix, and the similarity transformation has 
been accumulated in V. 

EXCHNG works as follows. The first block is used to determine an implicit QR 
shift. An arbitrary QR step is performed on both blocks to eliminate the uncoupling 
between them. Then a sequence of QR steps using the previously determined shift 
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is performed on both blocks. Except in ill-conditioned cases, a block of size B1 
having the eigenvalues of the first block will emerge in the lower part of the array 
occupied by both blocks, usually in one or two steps. If 30 iterations pass without 
convergence (the criterion is the same as in HQR3), the subroutine gives an error 
return. 

Both HQR3 and EXCHNG use the subroutine QRSTEP to perform the QR 
iterations. In addition, HQR3 uses the subroutine SPLIT to separate real eigen- 
values of a 2X2 block. 
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ALGORITHM 

SUBROUTINE HQR3(A, V, N, NLOW, NUP, EPS, ER, EL, TYPE, NA, NV) HQR §1¢ 

INTEGER N, NA, NLOW, NUP, NV, TYPE(N) HQR 2¢ 

REAL A(NA,N), EI(N), ER(N), EPS, V(NV,N) HQR 3¢ 
C HQR3 REDUCES THE UPPER HESSENBERG MATRIX A TO QUASI- HQR 40 
C TRIANGULAR FORM BY UNITARY SIMILARITY TRANSFORMATIONS. HQR 5 
C THE EIGENVALUES OF A, WHICH ARE CONTAINED IN THE 1X1 HQR 6¢@ 
C AND 2X2 DIAGONAL BLOCKS OF THE REDUCED MATRIX, ARE HQR 7 
C ORDERED IN DESCENDING ORDER OF MAGNITUDE ALONG THE HQR 8@ 
C DIAGONAL. THE TRANSFORMATIONS ARE ACCUMULATED IN THE HQR 9 
C ARRAY V. HQR3 REQUIRES THE SUBROUTINES EXCHNG, HQR 160 
C QRSTEP, AND SPLIT. THE PARAMETERS IN THE CALLING HQR 1106 
C SEQUENCE ARE (STARRED PARAMETERS ARE ALTERED BY THE HQR 12 
C SUBROUTINE) HQR 13¢ 
Cc *A AN ARRAY THAT INITIALLY CONTAINS THE N X N HQR 14@ 
Cc UPPER HESSENBERG MATRIX TO BE REDUCED. ON HQR 1506 
Cc RETURN A CONTAINS THE REDUCED, QUASI- HQR 160 
Cc TRIANGULAR MATRIX. HQR 170 
Cc *V AN ARRAY THAT CONTAINS A MATRIX INTO WHICH HQR 18¢ 
Cc THE REDUCING TRANSFORMATIONS ARE TO BE HQR 199 
C MULTIPLIED. HQR 26¢ 
Cc N THE ORDER OF THE MATRICES A AND V. HQR 210 
Cc NLOW A(NLOW,NLOW-1) AND A(NUP,+1,NUP) ARE HQR 220 
Cc NUP ASSUMED TO BE ZERO, AND ONLY ROWS NLOW HQR 23¢@ 
Cc THROUGH NUP AND COLUMNS NLOW THROUGH HQR 240 
Cc NUP ARE TRANSFORMED, RESULTING IN THE HQR 250 
Cc CALCULATION OF EIGENVALUES NLOW HQR 26¢ 
Cc THROUGH NUP. HQR 27¢ 
Cc EPS A CONVERGENCE CRITERION. HQR 28¢ 
C *ER AN ARRAY THAT ON RETURN CONTAINS THE REAL HQR 29¢@ 
Cc PARTS OF THE EIGENVALUES. HQR 3060 
Cc *EL AN ARRAY THAT ON RETURN CONTAINS THE HQR 310 
C IMAGINARY PARTS OF THE EIGENVALUES. HQR 320 
Cc *TYPE AN INTEGER ARRAY WHOSE I-TH ENTRY IS HQR 330 
Cc @ IF THE I-TH EIGENVALUE IS REAL, HQR 340 
Cc 1 IF THE I-TH EIGENVALUE IS COMPLEX HQR 350@ 
Cc WITH POSITIVE IMAGINARY PART. HQR 360 
Cc 2 IF THE I-TH EIGENVALUE IS COMPLEX HQR 37 
Cc WITH NEGATIVE IMAGINARY PART, HQR 380 
Cc -1 IF THE I-TH EIGENVALUE WAS NOT HQR 390 
Cc CALCULATED SUCCESSFULLY. HQR 40¢ 
Cc NA THE FIRST DIMENSION OF THE ARRAY A. HQR 41¢ 
c NV THE FIRST DIMENSION OF THE ARRAY V. HQR 426 
C THE CONVERGENCE CRITERION EPS IS USED TO DETERMINE HQR 43¢ 
C WHEN A SUBDIAGONAL ELEMENT OF A IS NEGLIGIBLE. HQR 44@ 
C SPECIFICALLY A(I+1,1I) IS REGARDED AS NEGLIGIBLE HQR 45 
Cc IF HQR 4606 
c ABS(A(I+1),1)) .LE. EPS*(ABS(A(1,1))+ABS(A(I+1,I+1))). HQR 47¢ 


C THIS MEANS THAT THE FINAL MATRIX RETURNED BY THE HQR 486 
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C PROGRAM WILL BE EXACTLY SIMILAR TO A + E WHERE E IS HQR 490 
C OF ORDER EPS*NORM(A), FOR ANY REASONABLY BALANCED NORM HQR 5060 
C SUCH AS THE ROW-SUM NORM. HQR 510 
C INTERNAL VARIABLES HQR 52¢ 
INTEGER I, IT, L, MU, NL, NU HQR 53@ 

REAL El, E2, P, Q, R, S, T, W, X, Y, Z HQR 54@ 
LOGICAL FAIL HQR 550 

C INITIALIZE. HQR 56@ 
DO 1¢ I=NLOW, NUP HQR 579 

_ TYPE(I) = -1 HQR 58¢ 

16 CONTINUE HQR 59¢ 
T= ¢@. HQR 660 

C MAIN LOOP. FIND AND ORDER EIGENVALUES. HQR 610 
NU = NUP HOR 620 

2¢ IF (NU.LT.NLOW) GO TO 24¢ HQR 63¢ 
IT=@ HQR 646 

C QR LOOP. FIND NEGLIGIBLE ELEMENTS AND PERFORM HQR 65¢@ 
C QR STEPS. HOR 660 
3@ CONTINUE HQR 67@ 

C SEARCH BACK FOR NEGLIGIBLE ELEMENTS. HQR 68¢ 
L = NU HQR 69¢ 

40 CONTINUE HQR 700 

IF (L.EQ.NLOW) GO TO 5¢ HQR 71¢@ 

IF (ABS(A(L,L-1)).LT.EPS* (ABS (A(L-1,L-1) )+ABS(A(L,L)))) GO TO HQR 72¢ 

* 50 HQR 73¢@ 
L=L-1 HQR 74¢ 

GO TO 4@ HQR 750 

5@ CONTINUE HQR 76¢ 

C TEST TO SEE IF AN EIGENVALUE OR A 2X2 BLOCK HQR 77¢ 
C HAS BEEN FOUND. HQR 780 
X = A(NU,NU) HQR 790 

IF (L.EQ.NU) GO TO 16¢ HQR 80¢ 

Y = A(NU-1,NU-1) HQR 81¢ 

W = A(NU,NU-1)*A(NU-1,NU) HQR 82 

IF (L.EQ.NU-1) GO TO 106¢ HQR 83¢ 

C TEST ITERATION COUNT. IF IT IS 3@ QUIT. IF HQR 84¢ 
C IT IS 16 OR 2@ SET UP AN AD-HOC SHIFT. HQR 850 
IF (IT.EQ.30) GO TO 24¢ HQR 86¢ 

IF (IT.NE.1@ .AND. IT.NE.20) GO TO 7@¢ HQR 87¢ 

C AD-HOC SHIFT. HQR 88¢@ 
T=T+X HQR 89¢ 

DO 6¢@ I=NLOW,NU HQR 90¢ 
A(I,1I) = A(I,I) - x HQR 91¢ 

6@ CONTINUE HQR 92¢@ 

S = ABS(A(NU,NU-1)) + ABS(A(NU-1,NU-2) ) ; HQR 93¢ 

X = @.75*S HQR 94¢ 
Y=xX HQR 95¢ 

W = -G.4375*S**2 HQR 96¢ 

7@ CONTINUE HQR 97¢ 
IT=IT+1 HQR 98¢ 

C LOOK FOR TWO CONSECUTIVE SMALL SUB-DIAGONAL HQR 99¢ 
C ELEMENTS. HQR 16066 
NL = NU - 2 HQR 161¢ 

86 CONTINUE HQR 1062 

Z = A(NL,NL) HQR 1630 
R=X-Z HQR 1046 
S=#Y-Z HQR 105¢@ 

P = (R*S-W) /A(NL+1,NL) + A(NL,NL+1) HOR 106¢ 

Q = A(NL+1,NL+1) - Z-R-S HQR 1Q7¢ 

R = A(NL+2,NL+1) HQR 168¢ 

S = ABS(P) + ABS(Q) + ABS(R) HQR 1696 

P = P/S HQR 1100 

Q = Q/S HQR 111¢ 

R = R/S HQR 112¢ 

IF (NL.EQ.L) GO TO 9% HQR 113¢ 

IF (ABS(A(NL,NL~1) )* (ABS (Q)+ABS(R) ) .LE.EPS*ABS (P)* (ABS (A(NL-1, HQR 114¢ 

* NL-1))+ABS (Z)+ABS (A(NL+1,NL+1)))) GO TO 9¢ HQR 115¢ 

NL = NL - 1 HQR 116¢@ 

GO TO 8@ HQR 117¢ 

9% CONTINUE HQR 1180 

C PERFORM A QR STEP BETWEEN NL AND NU. HQR 119¢ 
CALL QRSTEP(A, V, P, Q, R, NL, NU, N, NA, NV) HQR 1200 

GO TO 3¢ HQR 1210 

C 2X2 BLOCK FOUND. HQR 122¢ 
160 IF (NU.NE.NLOW+1) A(NU-1,NU-2) = @. HQR 123¢@ 


A(NU,NU) = A(NU,NU) + T HQR 12406 
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A(NU-1,NU-1) = A(NU-1,NU-1) + T HQR 1250 
TYPE(NU) = @ HQR 1260 
TYPE(NU-1) = @ HQR 1270 

MU = NU HQR 1280 

C LOOP TO POSITION 2X2 BLOCK. HQR 1290 
116 CONTINUE HQR 13060 
NL = MU - 1 HQR 1319 

C ATTEMPT TO SPLIT THE BLOCK INTO TWO REAL HQR 1320 
C EIGENVALUES. HQR 1330 
CALL SPLIT(A, V, N, NL, El, E2, NA, NV) HQR 1340 

C IF THE SPLIT WAS SUCCESSFUL, GO AND ORDER THE HQR 1350 
C REAL EIGENVALUES. HQR 1360 
IF (A(MU,MU-1).EQ.@.) GO TO 17¢ HQR 1370 

C TEST TO SEE IF THE BLOCK IS PROPERLY POSITIONED, HQR 1380 
C AND IF NOT EXCHANGE IT HQR 1390 
IF (MU.EQ.NUP) GO TO 23¢ HQR 1400 

IF (MU.EQ.NUP-1) GO TO 13¢ HQR 14190 

IF (A(MU+2,MU+1).EQ.@.) GO TO 13¢ HQR 1429 

C THE NEXT BLOCK IS 2X2. HQR 1430 
IF (A(MU-1,MU-1)*A (MU ,MU)-A (MU-1 ,MU)*A (MU, MU-1) .GE.A(MU+1, HQR 1449 

* MU+1)*A (MU+2 ,MU+2)—-A (MU+1 ,MU+2)*A (MU+2 ,MU+1)) GO TO 23@ HQR 1459 

CALL EXCHNG(A, V, N, NL, 2, 2, EPS, FAIL, NA, NV) HQR 1460 

IF (.NOT.FAIL) GO TO 12@ HQR 1470 
TYPE(NL) = -1 HQR 1480 
TYPE(NL+1) = -1 HQR 1490 
TYPE(NL+2) = -1 HQR 1500 
TYPE(NL+3) = -1 HQR 1519 

GO TO 24¢ HQR 1520 

12@ CONTINUE HQR 1530 
MU = MU + 2 HQR 1540 

GO TO 15¢ HQR 1559 

13@ CONTINUE HQR 1564 

C THE NEXT BLOCK IS 1X1. HQR 1570 
IF (A(MU-1,MU-1)*A (MU,MU)-—A (MU-1,MU) *A (MU ,MU-1) .GE.A(MU+1, HQR 158¢ 

* MU+1)**2) GO TO 23¢ HQR 1599 

CALL EXCHNG(A, V, N, NL, 2, 1, EPS, FAIL, NA, NV) HQR 1669 

IF (.NOT.FAIL) GO TO 14@ HQR 161¢ 
TYPE(NL) = -1 HQR 1629 
TYPE(NI+1) = -1 HQR 1630 
TYPE(NL+2) = -1 HQR 164¢ 

GO TO 24¢ HQR 165¢ 

14@ CONTINUE HQR 166¢ 
MU = MU +1 HQR 1670 

15@ CONTINUE HQR 1680 
GO TO 11¢ HQR 1699 

C SINGLE EIGENVALUE FOUND. HQR 1700 
169 NL = @ HQR 1714 
A(NU,NU) = A(NU,NU) + T HQR 1726 

IF (NU.NE.NLOW) A(NU,NU-1) = @. HQR 1730 
TYPE(NU) = @ HQR 1740 

MU = NU HQR 175¢ 

C LOOP TO POSITION ONE OR TWO REAL EIGENVALUES. HQR 1760 
17@ CONTINUE HQR 1770 

C POSITION THE EIGENVALUE LOCATED AT A(NL,NL). HQR 1789 
18¢ CONTINUE HQR 1790 
IF (MU.EQ.NUP) GO TO 226 HQR 180¢ 

IF (MU.EQ.NUP-1) GO TO 249 HQR 1819 

IF (A(MU+2,MU+1).EQ.@.) GO TO 20 HQR 1829 

C THE NEXT BLOCK IS 2X2. HQR 1830 
IF (A(MU,MU)**2.GE.A(MU+1,MU+1) *A (MU+2 ,MU+2)-A (MU+1 ,MU+2)* HQR 1840 

* A(MU+2,MU+1)) GO TO 23@ HQR 1859 

CALL EXCHNG(A, V, N, MU, 1, 2, EPS, FAIL, NA, NV) HQR 1860 

IF (.NOT.FAIL) GO TO 19¢ HQR 1879 
TYPE(MU) = -1 HQR 1880 
TYPE(MU+1) = -1 HQR 1890 

TYPE (MU+2) = -1 HQR 190¢ 

GO TO 240 HQR 1914 

196 CONTINUE HQR 192¢ 
MU = MU + 2 HQR 193¢ 

GO TO 21¢ HQR 1949 

206 CONTINUE HQR 195¢ 

C THE NEXT BLOCK IS 1Xl. HQR 1969 
IF (ABS(A(MU,MU) ) .GE.ABS (A(MU+1,MU+1))) GO TO 220 HQR 1970 

CALL EXCHNG(A, V, N, MU, 1, 1, EPS, FAIL, NA, NV) HQR 1989 

MU = MU + 1 HQR 1990 


21¢ CONTINUE HQR 20660 


COLLECTED ALGORITHMS (cont.) 


GO TO 18¢ 


22@ CONTINUE 
MU = NL 

NL = 6 
IF (MU.N 

C GO BACK AND 
236 CONTINUE 
NU =L- 
GO TO 2@ 
C ALL THE EIGE 
C COMPUTE THEI 
24@ IF (NU.L 
DO 25¢ I 
A(I,1) 
250 CONTINUE 
26@ CONTINUE 
NU = NUP 
270 CONTINUE 
IF (TYPE 

NU = NU 
GO TO 31 
28@ CONTINUE 
IF (NU.E 
IF (A(NU 

C 2X2 BLOCK. 
CALL SPL 
IF (A(NU 
ER(NU) = 
EI (NU-1) 
ER(NU-1) 
EL(NU) = 
TYPE (NU- 
TYPE (NU) 

NU = NU 
GO TO 3¢ 
29% CONTINUE 
C SINGLE ROOT. 


30% CONTINUE 

31@ CONTINUE 
IF (NU.G 
RETURN 
END 


SUBROUTI 
INTEGER 
REAL A(N 
GIVEN THE UP 
STARTING AT 


ARE REAL, A 
BLOCK TO UPP 
OF LARGEST A 
ROTATION IS 
OR COMPLEX) 
IN THE CALLI 
ALTERED BY T 
*A 


xV 


NA 
NV 


gQagQgaNaaAaaaAaANnaanaaNnaNnannanannanaaaaa 


INTEGER 


E.@) GO TO 170 
GET THE NEXT EIGENVALUE. 


l 


NVALUES HAVE BEEN FOUND AND ORDERED. 
R VALUES AND TYPE. 
T.NLOW) GO TO 260 
=1,NU 
= A(I,I) + T 


(NU) .NE.-1) GO TO 28¢ 
- 1 
¢ 


Q.NLOW) GO TO 29 
»NU-1) .EQ.0.) GO TO 299 


IT(A, V, N, NU-1, El, E2, NA, NV) 
»NU-1).EQ.@.) GO TO 299 

El 
E2 
ER (NU) 

-EI(NU-1) 

1) =1 

22 
- 2 
i) 


E.NLOW) GO TO 27@ 


NE SPLIT(A, V, N, L, El, E2, NA, NV) 

L, N, NA, NV 

A,N), V(NV,N) 

PER HESSENBERG MATRIX A WITH A 2X2 BLOCK 
A(L,L), SPLIT DETERMINES IF THE 


CORRESPONDING EIGENVALUES ARE REAL OR COMPLEX. IF THEY 


ROTATION IS DETERMINED THAT REDUCES THE 
ER TRIANGULAR FORM WITH THE EIGENVALUE 
BSOLUTE VALUE APPEARING FIRST. THE 
ACCUMULATED IN V. THE EIGENVALUES (REAL 
ARE RETURNED IN El AND E2. 
NG SEQUENCE ARE (STARRED PARAMETERS ARE 
HE SUBROUTINE) 

THE UPPER HESSENVERG MATRIX WHOSE 2X2 
BLOCK IS TO BE SPLIT, 

THE ARRAY IN WHICH THE SPLITTING TRANS- 
FORMATION IS TO BE ACCUMULATED. 

THE ORDER OF THE MATRIX A. 

THE POSITION OF THE 2X2 BLOCK. 

ON RETURN IF THE EIGENVALUES ARE COMPLEX 
El CONTAINS THEIR COMMON REAL PART AND 
E2 CONTAINS THE POSITIVE IMAGINARY PART. 
IF THE EIGENVALUES ARE REAL, El CONTAINS 
THE ONE LARGEST IN ABSOLUTE VALUE AND E2 
CONTAINS THE OTHER ONE. 

THE FIRST DIMENSION OF THE ARRAY A. 

THE FIRST DIMENSION OF THE ARRAY V. 


INTERNAL VARIABLES 


je sea Pal 


THE PARAMETERS 


HQR 
HOR 
HQR 
HOR 
HOR 
HOR 
HOR 
HQR 
HOR 
HOR 
HOR 
HQR 
HOR 
HQR 
HQR 
HQR 
HQR 
HQR 
HQR 
HQR 
HOR 
HQR 
HQR 
HOR 
HOR 
HQR 
HQR 
HQR 
HOR 
HOR 
HQR 
HQR 
HQR 
HQR 
HOR 
HQR 
HOR 
HOR 
HOR 
HQR 
HOR 
HOR 
HQR 
HOR 
HQR 


SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
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COLLECTED ALGORITHMS (cont.) 


REAL P, Q, R, T, U, W, X, Y, Z 


X = A(L+1,1+1) 

Y = A(L,L) 

W = A(L,Lt1)*A(L+1,L) 
P = (Y-X)/2. 


Q = Pk*2 + W 
IF (Q.GE.@.) GO TO 19 
C COMPLEX EIGENVALUE. 


El=P+X 
E2 = SQRT(-Q) 
RETURN 


1¢@ CONTINUE 
C TWO REAL EIGENVALUES. SET UP TRANSFORMATION. 
Z = SQRT(Q) 
IF (P.LT.@.) GO TO 2¢ 
Z=P+zZ 
GO TO 3¢ 
2@ CONTINUE 
Z=P-2Z 
30 CONTINUE 
IF (Z.EQ.@¢.) GO TO 4@ 
R = -W/Z 
GO TO 5@ 
46 CONTINUE 
R= ¢. 
5@ CONTINUE 
IF (ABS (X+Z).GE.ABS(X+R)) Z = R 


Y=Y-xX-Z 
X = -Z 
T = A(L,L+1) 
U = A(L+1,L) 
IF (ABS(Y)+ABS(U) .LE.ABS (T)+ABS(X)) GO TO 60 
Q=U 
Psy 
GO TO 7¢ 

6@ CONTINUE 
Q=X 
P=T 


7@ CONTINUE 
R = SQRT (P**2+Q**2) 
IF (R.GT.@.) GO TO 8@ 
El = AC(L,L) 
E2 = A(L+1,L+1) é 
A(L+1,L) = @. 
RETURN 
8@ CONTINUE 
P = P/R 
Q = Q/R 
C PREMULTIPLY. 
DO 9% J=L,N 
Z = A(L,J) 
A(L,J) = P¥Z + Q*A(L41,J) 
A(L+1,J) = P*¥A(L+1,J) - Q*Z 
9% CONTINUE 
C POSTMULTIPLY. 
Ll=L+i1 
DO 10% I=1,L1 
Z = A(I,L) 
A(I,L) = P*Z + Q*A(I,L+1) 
AC(I,L+1) = PRA(I,L+1) - Q*Z 
10@ CONTINUE 
C ACCUMULATE THE TRANSFORMATION IN V. 
DO 119 I=1,N 
Z = VC(I,L) 
V(I,L) = P*¥Z + Q*V(I,L+1) 
V(I,L+1) = P*V(I,L+L) - Q*Z 
11¢ CONTINUE 
A(L+1,L) = @. 
El = A(L,L) 
E2 = A(L+1,L+1) 
RETURN 
END 


SUBROUTINE (EXCHNG(A, V, N, L, Bl, B2, EPS, FAIL, NA, NV) 


INTEGER Bl, B2, L, NA, NV 


SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 
SPL 


EXC 
EXC 


300 
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ANQAQDQDAANAANAAANDAANANANAANDAAANAANAANDANAANRNAAAN 


Cc 


Cc 


REAL A(NA,N), EPS, V(NV,N) 

LOGICAL FAIL 
GIVEN THE UPPER HESSENBERG MATRIX A WITH CONSECUTIVE 
BLXBl AND B2XB2 DIAGONAL BLOCKS (B1,B2 .LE. 2) 
STARTING AT A(L,L), EXCHNG PRODUCES A UNITARY 
SIMILARITY TRANSFORMATION THAT EXCHANGES THE BLOCKS 
ALONG WITH THEIR EIGENVALUES. THE TRANSFORMATION 
IS ACCUMULATED IN V. EXCHNG REQUIRES THE SUBROUTINE 
QRSTEP., THE PARAMETERS IN THE CALLING SEQUENCE ARE 
(STARRED PARAMETERS ARE ALTERED BY THE SUBROUTINE) 


*A THE MATRIX WHOSE BLOCKS ARE TO BE 
INTERCHANGED. 

*V THE ARRAY INTO WHICH THE TRANSFORMATIONS 
ARE TO BE ACCUMULATED. 

N THE ORDER OF THE MATRIX A. 

L THE POSITION OF THE BLOCKS. 

Bl AN INTEGER CONTAINING THE SIZE OF THE 
FIRST BLOCK. 

B2 AN INTEGER CONTAINING THE SIZE OF THE 
SECOND BLOCK. 

EPS A CONVERGENCE CRITERION (CF. HQR3). 


*FAIL A. LOGICAL VARIABLE WHICH IS FALSE ON A 
NORMAL RETURN. IF THIRTY ITERATIONS WERE 


PERFORMED WITHOUT CONVERGENCE, FAIL IS SET 


TO TRUE AND THE ELEMENT 
A(L+B2,L+B2-1) CANNOT BE ASSUMED ZERO. 
NA THE FIRST DIMENSION OF THE ARRAY A. 
NV THE FIRST DIMENSION OF THE ARRAY V. 
INTERNAL VARIABLES. 
INTEGER I, IT, J, Ll, M 
REAL P, Q, R, S, W, X, Y, Z 
FAIL = .FALSE. 
IF (B1.EQ.2) GO TO 79 
IF (B2.EQ.2) GO TO 46 
INTERCHANGE 1X1 AND 1X1 BLOCKS. 
Ll=L+1 
Q = A(Lt1,L+1) - A(L,L) 
P = A(L,L+tl1) 
R = AMAX1(P,Q) 
IF (R.EQ.@.) RETURN 


P = P/R 

Q = Q/R 

R = SQRT(P**2+Q%*2) 
P = P/R 

Q = Q/R 

DO 1 J=L,N 


S = P*A(L,J) + Q*A(L41,J) 
A(L+1,J) = P*A(L+1,J) - Q*A(L,J) 


A(L,J) = S$ 
16 CONTINUE 
DO 2¢@ I=1,L1 


S = PkA(I,L) + Q*A(I,L41) 
A(I,L+1) = P*A(I,L+1) - Q*A(I,L) 
A(I,L) = S 
20 CONTINUE 
DO 3¢ I=1,N 
S = P*V(I,L) + Q*&V(I,L+1) 
V(I,L+1) = P*V(I,L+1) - Q*V(I,L) 
V(I,L) = S 
3@ CONTINUE 
A(L+1,L) = @. 
RETURN 
46 CONTINUE 


INTERCHANGE 1X1 AND 2X2 BLOCKS. 
X = A(L,L) 
Pe=l, 
Q=l. 
R= 1, 
CALL QRSTEP(A, V, P, Q, R, L, L+2, N, NA, NV) 
IT = @¢ 


5@ IT = 1T+1 
IF (IT.LE.3¢) GO TO 6¢ 
FAIL = .TRUE. 
RETURN 

60 CONTINUE 
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COLLECTED ALGORITHMS (cont.) 


70 
C INT 


89 


96 


UPP 
BY 

ROW 
ARE 
SEQ 
SUB 


INT 


19 


P = A(L,L) - X 

Q = A(L+1,L) 

R= @. 

CALL QRSTEP(A, V, P, Q, R, L, L+2, N, NA, NV) 

IF (ABS(A(L+2,L+1)) .GT.EPS* (ABS (A(L+1,L+1) )+ABS(A(L+2,L+2)))) 
* GO TO 50 

A(L+2,L+1) = @. 


RETURN 
CONTINUE 
ERCHANGE 2X2 AND B2XB2 BLOCKS. 

M=L+2 

IF (B2.EQ.2)M=M+4+1 

X = A(Lt+1,L+1) 

Y = A(L,L) 

W = A(L+1,L)*A(L,L+1) 

Pe=l, 

Q=1. 

R= 1, 

CALL QRSTEP(A, V, P, Q, R, L, M, N, NA, NV) 
IT = @ 

IT=IT+1 


IF (IT.LE.3@) GO TO 90 

FAIL = .TRUE. 
RETURN 
CONTINUE 
A(L,L) 
X-Z 

Yoo 

(R*S-W) /A(L+1,L) + A(L,L+1) 
A(L+1,L+1) -Z-R-S 
A(L+2,L+1) 
ABS(P) + ABS(Q) + ABS(R) 

P/S 

Q/s 
= R/S 

CALL QRSTEP(A, V, P, Q, R, L, M, N, NA, NV) 
IF (ABS(A(M-1,M-2) ) .GT.EPS* (ABS (A (M-1,M-1) )+ABS (A(M-2,M-2) ))) 
* GO TO 8¢ 

A(M-1,M-2) = @. 

RETURN 

END 


bot t tb t t oo 


DBOWNDAOWVNAAN 


SUBROUTINE QRSTEP(A, V, P, Q, R, NL, NU, N, NA, NV) 
INTEGER N, NA, NL, NU, NV 
REAL A(NA,N), P, Q, R, V(NV,N) 


QRSTEP PERFORMS ONE IMPLICIT QR STEP ON THE 


ER HESSENBERG MATRIX A. THE SHIFT IS DETERMINED 
THE NUMBERS P,Q, AND R, AND THE STEP IS APPLIED TO 
S AND COLUMNS NL THROUGH NU. THE TRANSFORMATIONS 
ACCUMULATED IN V. THE PARAMETERS IN THE CALLING 


UENCE ARE (STARRED APRAMETERS ARE ALTERED BY THE 

ROUTINE) 

A THE UPPER HESSENBERG MATRIX ON WHICH THE 
QR STEP IS TO BE PERFORMED. 

RV THE ARRAY IN WHICH THE TRANSFORMATIONS 
ARE TO BE ACCUMULATED 

*P PARAMETERS THAT DETERMINE THE SHIFT. 

*Q 

*R 

NL THE LOWER LIMIT OF THE STEP. 

NU THE UPPER LIMIT OF THE STEP. 

N THE ORDER OF THE MATRIX A. 

NA THE FIRST DIMENSION OF THE ARRAY A. 

NV THE FIRST DIMENSION OF THE ARRAY V. 


ERNAL VARIABLES. 

INTEGER I, J, K, NL2, NL3, NUM 
REAL S, X, Y, Z 

LOGICAL LAST 

NL2 = NL + 2 

DO 1@ I=NL2,NU 

A(I,I-2) = @. 

CONTINUE 

IF (NL2.EQ.NU) GO TO 3¢ 

NL3 = NL + 3 


EXC 


EXC 
EXC 


EXC 
EXC 


EXC 
EXC 


EXC 
EXC 


QRS 
QRS 


QRS 
QRS 


QRS 
QRS 


QRS 
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(20 
36 


C DETE 


DO 2¢ I=NL3,NU 
~ AC(I,1-3) = @. 
CONTINUE 
CONTINUE 
NUM1 = NU - 1 
DO 130 K=NL,NUM1 
RMINE THE TRANSFORMATION. 
_ LAST = K.EQ.NUMIL 
IF (K.EQ.NL) GO TO 4@ 
P = A(K,K-1) 
Q = A(K+1,K-1) 
R= @. ; 


IF (.NOT.LAST) R = A(K+2,K-1) 


X = ABS(P) + ABS(Q) + ABS(R) 


"IF (X.EQ.0.). GO 70 130 


4Q 


50 
60 


P = P/X 
Q = Q/x 
R = R/X 
CONTINUE 
 S = SQRT (P¥*2+Q**2+RE*2) 
IF (P.LT.@.) S = -S 
IF (K.EQ.NL) GO TO 5@ 
A(K,K-1) = -S*X 


' GO TO 66 
CONTINUE 
IF (NL.NE.1) A(K,K-1) = -A(K,K-1) | 
CONTINUE 
P=P+S5 
X = P/S 
Y = Q/S 
Z = R/S 
Q = Q/P 
R = R/P 


C PREMULTIPLY. 


70 


80 


DO 8¢ J=K,N 
P = A(K,J) + Q*A(K+1,J) 
IF (LAST) GO TO 7¢ 
P = P + R*¥A(K+2,J) 
A(K+2,J) = A(K+2,J) - P*Z 
CONTINUE 
ACK+1,J) = A(Kt+1,J) - P*Y 
A(K,J) = A(K,J) -— P*X 
CONTINUE 


C POSTMULTIPLY. 


90 


100 


C ACCUMULATE THE TRANSFORMATION IN V. 


110 


126 
136 


J = MIN@(K+3,NU) 

DO 106 I=1,J 
P = X*A(I,K) + Y*A(1,K+1) 
IF (LAST) GO TO 9¢ 
P = P + Z*A(1I,K+2) 
A(I,K+2) = A(1I,K+2) - P*R 


CONTINUE 

A(I,K+1) = A(I,K+l) - P*Q 

A(I,K) = A(I,K) - P 
CONTINUE 


DO 12@ I=1,N 
P = X*V(I,K) + Y*V(I,K+1) 
IF (LAST) GO TO 116 
P = P + Z*V(L,K+2) 
V(I,K+2) = V(I,K+2) - P*R 
- CONTINUE 
V(I,K+tl) = V(I,K+1) - P*Q 
V(I,K) = V(I,K) - P 
CONTINUE 
CONTINUE 
RETURN 
END 


QRS 
QRS 
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REMARK ON ALGORITHM 506 


HQR3 and EXCHNG: Fortran Subroutines for Calculating and Ordering the 
Bigenvalues of a Real Upper Hessenberg Matrix [G.W. Stewart, ACM Trans. 
Math. Softw. 2, 3(Sept. 1976), 275-280] 


David S. Flamm and Robert A. Walker [Received 21 September 1981, accepted 
20 February 1982] 


D.S. Flamm, Aerospace Corporation, P.O. Box 92957, Los Angeles, CA 90009; 
R.A. Walker, Integrated Systems, 151 University Avenue, Suite 400, Palo Alto, 
CA 94301. 


The following four corrections should be made to program HQR3 []1, 2]: 


(1) Line HQR 720 in [2] should have the comparison “.LE.” instead of “.LT.”. 

(2) Line HQR 1850 in [2] should branch to “220” instead of “230”. 

(3) Line HQR 2130 should read “DO 250 I = NLOW, NU”, instead of “DO 250 
I= 1, NU”. 

(4) Line EXC 410 should read “R = AMAX1(ABS(P), ABS(Q))” instead of “R 
= AMAX1(P,Q)”. 


The following example illustrates why the first two corrections are necessary. 
Apply HQR3 to the matrix 


coo co ow oO 
cooocoun 
| 
ooho co 
oooh oon 
eoocroeoose 
OoOrocooco 


An uncorrected version of HQR3 will yield a division by zero in line HQR 1060 of 
[2] as a result of the test in (1). In checking for a zero subdiagonal element, the 
criterion is the sum of the magnitudes of the two diagonals. As the example 
shows, when both diagonals are zero, the .LT. test fails for an exactly zero 
subdiagonal element. 

Without correction (2), when exchanging two upper real roots with a lower 2 
x 2 block, only the bottom root is tested and exchanged, leaving the possibility 
of misordering of the top root. The example above also demonstrates this problem. 

Without correction (3), the program would give the wrong diagonals in an 
unusual case where part of a matrix was being triangularized and the routine 
failed to converge. 

Correction (4) is necessary when the superdiagonal element is zero between 
two real roots, leaving the possibility that the maximum of (P,Q) is P = 0 for Q 
negative. (If (P,Q) are both zero, no exchange is required and the program 
properly returns.) 


REFERENCES 
1. STEWART, G.W. HQR3 and EXCHNG: Fortran subroutines for calculating and ordering the 
eigenvalues of a real upper Hessenberg matrix. ACM Trans. Math. Softw. 2, 3 (Sept. 1976), 
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ALGORITHM 507 
Procedures for Quintic Natural Spline 
Interpolation [ E1| 


JOHN G. HERRIOT 

Stanford University 

and 

CHRISTIAN H. REINSCH 

Leibniz-Rechenzentrum der Bayerischen Akademie der Wissenschaften, Germany 


Key Words and Phrases: approximation, interpolation, spline, spline approximation, 
quintic natural spline 
CR Categories: 5.13 
Language: Algol W 


DESCRIPTION 


1. Introduction 


The purpose of the procedures presented here is to determine the interpolating 
quintic natural spline function S(x) for the set of data points (2.,yi), 7 = 
N1,N1+1,...,N2, where it is assumed that ay. < tutu. < +++ < tye. The inter- 
polating quintic natural spline function S(x) with the knots rm, ..., tw2 has the 
following properties: (i) S(z) is a polynomial of degrec 5 in each interval (2;, 2:41), 
i= M1,...,N2—1. (ii) S(x) and its derivatives S’(x), S” (x), 8” (x), and 8” (x) 
are continuous in [zw1,2y2]. (iii) S” (am) = S” (axe) = S’”’ (am) = 8” (ane) = 0. 
(iv) S(vi) = yi, 1 = N1,..., Ne. It is known that if N2 > N1+1, then there is a 
unique quintic natural spline function which has the properties (i)—(iv). (See, for 
example, Greville [3, 4].) This spline function can be represented in the form 


Sie) =y + Bt+ Ci? + D+ Et + Fb (1) 


witht = « —a,;fora; <2 <ain,i=N1,...,N2—1. 

The procedure QUINAT computes the coefficients B;, C:, D;, E,;, F; of the 
quintic natural spline represented as in eq. (1) for an arbitrary set of data points 
(x; ,y:) a8 previously specified. This procedure is much faster than the procedure 
NATSPLINE of ACM Algorithm 472 [6] with m = 3. An even faster procedure, 
QUINEA, is provided for the case in which the knots x; are known to be equidis- 
tant. In this case it is not necessary to specify the values of x; . The representation 
(1) is still used, but nowt = («—«,)/h, where h = 2i41—2; , the constant spacing 
of the knots. 


Received 20 June 1974. 
Copyright © 1976, Association for Computing Machinery, Inc. General permission to repub- 
lish, but not for profit, all or part of this material is granted provided that ACM’s copyright 
notice is given and that reference is made to the publication, to its date of issue, and to the 
fact that reprinting privileges were granted by permission of the Association for Computing 
Machinery. 

This work was supported in part by the National Science Foundation, under Grant GJ-29988X. 
Authors’ addresses: J.G Herriot, Department of Computer Science, Stanford University 
Stanford, CA 94305; C.H. Reinsch, Leibniz-Rechenzentrum der Bayerischen Akademie der 
Wissenschaften, 8 Miinchen 2, Germany. 
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If at one or more of the knots z; one also specifies the derivative y; , thus requiring 
S'(z:) = y:, then one has to give up the condition that S”” (x) be continuous at 
the knot x; . If the second derivative y;’ is also specified, thus requiring S’(x:) = 
y:, then one must also give up the condition that 8S” (zx) be continuous at z,. 
QUINAT is designed so that it can be used in these cases with the convention that if 
two consecutive knots are equal, say 2; = vj41, then S(a;) = y;and S'(a;) = yju, 
and if three consecutive knots are equal, say 2; = 2j41 = 242, then S(z;) = y;, 
S'(a;) = y;, and S”(x;) = yj42. Thus in order to use QUINAT in the case that 
both the value y; and the first derivative y; are specified at 2; , one increases the 
number of knots by I setting 7;,1 = x; (and renumbering the knots and values to 
the right). Then one chooses y;41 = y;. The spline function computed by QUINAT 
will have the property S(a;) = y; and S’(z,) = y;4,. One may use QUINAT in a 
similar manner if the second derivative is also specified at a knot x;. Complete 
details are given in the comment of the procedure QUINAT. 

If the values of the function y; and the values of the first derivative y; are speci- 
fied at all the knots z;, then S”’(x) need not be continuous at the knots 
and S’”’ (2m) and S’”(ay2) need not be zero. Such a spline is said to be of defi- 
ciency 2. The procedure QUINDF computes the coefficients of the quintic natural 
spline of deficiency 2 when the values of the function y; and the values of the first 
derivative y; are given at each knot. Although QUIN AT could be used for this case 
as just described, QUIN DF is much faster and needs much less storage space. 

It is not of interest to specify the values of the function and its first and second 
derivatives at each knot, because in this case the quintic polynomial is completely 
determined in each interval independently of all other intervals. 


2. Method of Calculation 


QUINAT. As in the general case of Algorithm 472 [6], the calculation of the co- 
efficients of the spline function is carried out in a numerically stable manner follow- 
ing a method described by Anselone and Laurent [1]. The basic ideas on which the 
method is based were given earlier by Schoenberg [7]. The method is specialized to 
the case of the quintic natural spline and uses minimum support B-splines [2, 3] of 
degree 2 to form a basis for the class of third derivatives of the quintic natural 
splines. Instead of specializing the formulas of Algorithm 472 [6] by setting m = 38, 
we derive the necessary formulas directly and we choose a different numbering and 
a different normalization for the B-splines. 

We first assume that the knots are strictly monotone increasing, that is, 
tui < Xwign < +++ < Xyo. In order to simplify the notation, we choose N1 = 0 
and let N2 = n, so that the data points are denoted by (a;, yi), 7 = 0,1,...,. 
We denote by M.(x) the B-spline of degree 2, vanishing outside the inter- 
val (4-1, ize). Welet hi = tin — 21, (= U—-Bin, UH UX—U,V=He — Viz. 


Then we have 


Mix) = AP, Bisex <a, 
= B+ Cu — Dv, i SU < tin, (2) 
= E(n — his)’, Lit SU < Lie, 
where 
A = 1/[hia(hin + hi)), B= hin/(hia + hi), C = 2/(hia + hi), (3) 


D = (hin + 2hi + hiss) /Uhia + hdAChi + hig), HB = Uthiga(hs + higs)]. 


Now since the third derivative S” (x) vanishes outside the interval (xo, Xn), it 
has a unique representation of the form 


8" (2) = YL 60yM,(2). (4) 


In order to determine the y; , we make use of the relation 


[ M (a) 8S" (x) dx = 2(S(xi, Fi41, Vin) — S(Xi-1, 2s, Tiv1)) (5) 
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using the usual notation for divided differences. This relation is easily obtained 
by integration by parts. If we multiply eq. (4) by 3M.(z), 7 = 1, 2,... ,n—2, 
and integrate, we obtain a well-conditioned positive definite pentadiagonal system 
of linear equations for the determination of the y;: 
diy: + erye + fivs = 
eryi + dey2 + exys + fovs = C2 
fi-vyi-2 + Gaya + divi + Cryinn + fivigg = Gr, 1 = 3,4,..., 0-4 (6) 
Sn—sYn—5 ae €n—4Yn—-4 + An—8Yn--3 €n—8Yn—2 = Cn—-3 


Fn—¢¥n—4 F €n—8Y¥n—3 + Un—2¥n—-2 = Cn-2 
where 
d=™%+%4+ Ts, 4=1,2,...,n—2, 
e = 7,47, 4=1,2,...,n—-3, 
fi = Te, a= 1,2,...,n—4, 
Co = Yori — Yow, t= 1,2,...,n-2. 


Here y;,:41,:42 denotes the second divided difference of the given {y.:}, and for the 
T; one finds, after some algebraic manipulation, the following formulas: 


Ty = 6hi-a/(hia + hi)? 


T, = hA§BOhRi shia + (hia + higa) hi( 40h shins + 14h,’) 

+ iLO (hia + his) + 42h aliga + She} /[(hea + ha) ?(hi + heist)’ 
Ts = Ghiss/(hi + hist)” 
T, = hethia(hi + hist) + 38(hia + hi) (hi + Bhi) V(r + As) (hi + Aiga)’] 
Ts = Nisalhigo(hi + hiss) + BChiga + hsge) (Bhs + eg) [Che + isa) *Chiga + hige)] 
Ts = hiaa/[Ai + Aes) (hign 4+ hia) ]. 


Note that all terms in these expressions are positive; consequently no cancella- 
tions can occur. The system of equations (6) can be solved for the y; by using Gaus- 
sian elimination without pivoting. When the coefficients y; have been found, S” (x) 
is given by eq. (4). Remembering that M,(x) vanishes outside the interval 
(%;-1, £342) and making use of eqs. (1) through (4), we easily find that 


D./10 = (yithi + yihin) /(hin + Ai) 

EJS = (vi — via)/(hia + hi) 

Fe = (V/hi) (vist — vi) /(i + hit) 

a (y: o= yi-1) / (hin + h.)). 

These formulas can also be used for 7 = 0,1,n—2,n—1 by adding the convention 
that y1 = Yo = Yn-1 = Yn = 0. (Note that Do = Eo = 0 as they should.) Finally 
we make use of the continuity of S(x) and its first four derivatives at x; to obtain 
the following formulas for B; and C; : 


fot hia Yi — Y: h: YE... a | P eee 
ee hiath  h; 5 hase Dihithi + Eishiahi(hia — hi) 


hiah; 3 3 
aaa # (Fiahia + Fh?) 
— 1 Yinn — Y: = Yi uct) Fee 
ie hath ( h; hiv aaa a) 
hia + hi 1 4 ‘ 
— Ey; hava he + aaa (Fyahi-a — Fh; ). 
These formulas are valid for 7 = 1,2,...,—1. In addition, we have for the end- 
points: 


Co = Ci — 10Fo ho’, Bo = (y1 — Yyo)/ho — Coho — Fo ho’, 
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Cc, = Cua + 10F,,-1h5-1, B,, = (Yn — Yn—1)/Rn—1 + Crh —l —Fra Wea 


In the preceding discussion we have assumed that the knots were distinct. We can 
relax this condition and allow two or three consecutive knots to be equal. The proce- 
dure QUINAT has been written in such a way that if 7; = 2j41, then S(z;) = y; 
and S'(a;) = yji1, and if x; = 24. = 242, then, in addition, S”(2j) = yj4.. 
The use of QUIN AT in these cases is fully explained in its comment. 

QUINEQ. The calculation of the coefficients in QUIN EQ for the case of equi- 
distant knots is carried out in the same manner as is the calculation of the coeffi- 
cients in QUIN AT for the general case. However, there are a number of simplifica- 
tions which result in considerable economy of computational effort. It is not neces- 
sary to specify x;. Hence we can assume x; = 7. Then A; = 1 for all 7, and the co- 
efficients of M;(x) are independent of 7 as are also the d;, e., f: of the pentadiagonal 
system (6) for the y; . Thus eqs. (2) reduce to 


af, i-1<2x <i, 
Mix) = st+u-—uv, i<2x<itl, 
1q—1)*, t+1<2<i42, 
withhi=a—(i-l)u=2—-—t407=2-(i+1). 
Instead of eq. (4) it is convenient to take 


n—3 
8" (x) = a 1207;M j41(z). 
ja 
The divided differences become ordinary differences so that eq. (5) becomes: 
| M,(2)S” (x) dx = A*S(2;-1). 


The pentadiagonal system (6) for the determination of y; becomes: 
6670 + 2671 + v2 = A*yo 
26y0 + 66y1 + 2672 + 3 = Ay, 
Yi-g + 267-1 + 667; + 267i41 + ize = A*y; ee de ee n—5 
Yn—6 + 26yn—-5 + 66yn—-1 + 26yn-s 
Yn-—5 + 26Yn—4 + 66yn-3 = A’ nN—-s > 


The equations for the determination of the spline function coefficients then be- 


MYn—4 


come: 

D:/10 = yi-2 + Yi-1 B, = 4 (yin — Yiu — Fina — Fi) — D: 
Ei/5 9 = yi-1 — Vi-e Ci =4tywutyat Pia — Fi) —y: — Ki. 
F; =i ek ese ee 


These formulas are valid for 7 = 1, 2,...,n—1 with the convention that y1 = 
Yn—2 = Yn_1 = 0. The formula for F; can be used for i = 0 by setting y_2 = 0. (Note 
that Do = Ey = 0 as they should.) Finally the coefficients B; and C; at the endpoints 
are given by 


Il 


Co C1 - 10Fo, Bo = yw — yo — Co — Fo, 
Ca = Cat + 10F,-1, B, = Yn — Yn-1 + Ch = Fra . 


QUINDF. We now assume S(xz:) = y; and S’(#:) = y; are specified at each of 
the knots. We must exclude the possibility that x; = 2,41: as this would imply a mul- 
tiplicity of 4, which is not feasible for quintic splines. 

We could proceed as in the calculation of QUINAT by using minimum support 
B-splines of degree 2 to form a basis for the class of third derivatives of the quintic 
natural splines. Of course, the B-splines would also have to be of deficiency 2. We 
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would again obtain a pentadiagonal system of equations which could be solved and 
then the coefficients for the deficient quintic natural spline could be calculated. An 
algorithm based on this method was developed and tested by the present authors 
[5]. 

However, we have found that we can obtain a more efficient algorithm by impos- 
ing the appropriate continuity conditions directly on eq. (1) at the knots. A similar 
method was used by Spath [8] to obtain an algorithm for the deficient quintic spline 
but with different end conditions. (He specified the second derivatives at the end- 
points of the interval instead of requiring the third derivative to be zero at the 
endpoints as for the natural spline.) 

Using eq. (1) we see at once that 8’(x;) = y; implies B; = y,. Then imposing 
the requirement that S(«), S’(x), and S” (x) be continuous at x41, 7 = 0,1,..., 
n—2, we obtain by setting t = hi = vi41 — x, in eq. (1): 


Yur = Yi t+ Bait Che oF Djhi Eihi a= Fae 
Biss = By + 20h; + 8Dii + 4B Ae + SPAS (7) 
Cin = Cr + 8Dihi + OLA? + 10F Ae. 


If we multiply these three equations by 10/h,*, —4/h.’, 1/h; , respectively, and add 
the results, we eliminate E; and F; and obtain 


AB ia1 + 6B; ab Crsa oe 3C; 
h2 h: ; 


We note that D; = S” (x; + 0)/6. In order to obtain a similar expression for 
8” (x; — 0) /6, we replace the subscript ose by 7—1 consistently (noting that then 
h; = Xia — 2.18 to be replaced by tia — t= —hj1). We obtain 
ag” " z= yi — Yu OBe+ 4Bia , 380; — Cia 
ee ic ane a a hi-1 a hia — 
Now since the third derivative is continuous at z;, we can equate the values of 
S’” (a: + 0)/6 and 8” (x; — 0) pe in eqs. (8) and (9) to obtain the following set of 
equations for the C; : 


D, = 10 (8) 


(9) 


1 


3 3 
i hes Cina ++ (@ + 2) C; s. hi Cina 
T, (us = Ys _ yiryir) _ 4Biys + Bs , 6Bs + 4Bis 
he Wy he a. 
These equations hold for 7 = 4, 2,...,n—I1. Two additional equations can be ob- 


mM 


tained from the conditions S” ha) = ‘8 (%n) = 0 by setting 7 = 0 in eq. (8) and 
by setting 7 = nin eq. sa 


3 t _ yi — yo _ 4B, + 6B 
oe * 7,01 = 10 he he” 
1 3 Yn = Yn-1 6B,, + 4Bn-1 
ay emer es Cy aa C, == — = — 
ae Mie ee 


This system of n+1 equations is solved to obtain the C; . If we make the substitu- 
tions 


r= D,, P= (yin — ys — Bhi — Cie) /hi, 
y= Eh, q = (Biya — B; — 2C;hi)/hi, 
,£ = Fhe, r= (Cian — Ci) /h; , 


then for each 7 eqs. (7) form a system of three equations in the three unknowns 
x, y, 2, and the system is solved by Gaussian elimination. The backward substitution 
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yields formulas for z, y, x in the following order: 
g =q-—3p 
r—3(p +9) 


~ 
I 


=g—-z-2 


y 
r=p—y-z 
F 


‘= z/he 
E; = y/h; 
|D; = 1. 


3. Tests 


These procedures have been tested in Algol 60 on the Telefunken TR-440 computer 
at the Leibniz-Rechenzentrum of the Bavarian Academy of Sciences, Munich, and 
in Algol W on the IBM 360/67 at the Stanford Center for Information Processing. 
The latter tests included timing tests of the procedures with the number of knots 
N = N2 — N1 + 1 ranging up to 1000. The time was found to be approximately 
proportional to the number N of knots. The time T in seconds for the execution of 
the procedure QUIN AT was found to be approximately 7’ = .00193N, whereas for 
the procedure NATSPLINE of Algorithm 472 [6] with m = 3 it was found to be 
T = .0120N, or over six times as great. For the procedure QUINEQ the time was 
approximately 7 = .00064N, whereas for the procedure NATSPLINEEQ of 
Algorithm 472 [6] with m = 3 it was T = .0038N, or nearly six times as great. For 
the procedure QUINDF the time was approximately TJ’ = .00087N, whereas for the 
procedure QUINAT with 2N knots, consecutive knots being equal in pairs, the time 
was JT’ = .00325N, or nearly four times as great. Moreover, to compute the same 
results the procedure QUINAT requires approximately twice as much storage for 
the arrays used as does the procedure QUINDF. Note also that from the preceding 
formula for the time required by the procedure QUINAT, the time for 2N distinct 
knots would be T = .00386N, which can be compared with T = .00325N given 
above for N pairs of equal knots. The reduction for the case of double knots occurs 
because some calculations are omitted when knots are coincident. 

These timing comparisons show that it is definitely advantageous to use these 
special procedures for the quintic natural spline rather than the general cases given 
in Algorithm 472 [6] with m = 3. 

Tests of the accuracy and correctness of the coefficients computed by the proce- 
dures QUINAT, QUINEQ, and QUINDF were carried out as described in Algo- 
gorithm 472 [6]. Table I shows the results of a typical run using QUINDF for 5 
nonequidistant points. The values of the function and its first derivatives were 
specified. The first line of each entry gives the tabulated quantities at the given 


Table I. Quintic Spline Calculated by QUINDF 
(Machine precision approximately 7 decimal digits.) 


S"(x)/2 S"" (x) /6 Sx) /24 SY (x) /120 


S(x) 


-3.000000 
-1.000000 
3.000000 


4.000000 


7.000000 2.000000 -6.108377 ~5.722046'-06 2.956286 -0.7145951 
11.00000 15.00000 7.674876 -4.933508 ~4.189662 -0.7145951 
11.00000 15.00000 7.674870 -4.933474 -8.157658 5.416262 
26.00000 9.999996 -1. 908880 16.59851 18.92365 5.416262 
26.00000 10.00000 -1. 908880 16.59848 -9.059000 1.246086 
55.99942 ~27.00066 -5.264791 20.03839 9.632320 1.246088 
56.00000 -27.00000 -5.264426 20.03847 -21.28366 6.509618 
29.00000 -30. 00000 -7.754811 ~1.907349'-06 11. 26443 6.509616 
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value of x which is the lefthand endpoint of the subinterval; the second line of each 
entry gives the tabulated values at the righthand endpoint of the same subinterval. 
The close agreement of the quantities S(x), 8’(x), S”(x)/2, and S” (x) /6 shows 
that the quintic spline function and its derivatives satisfy the required continuity 
conditions. This is a good indication of the correctness of the results. Note that the 
fourth and fifth derivatives are discontinuous. Essentially the same results were 
obtained by using QUINAT with 10 knots, in equal pairs. In addition, accuracy 
and timing tests were carried out for large values of N, including N = 1000 and 
5000, and produced very satisfactory results. 
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ALGORITHM 
PROCEDURE QUINAT(INTEGER VALUE N1,N2;. REAL ARRAY X,Y,B,C,0,E,F(*)); l. 
COMMENT QUINAT COMPUTES THE COEFFICIENTS OF A QUINTIC NATURAL SPLINE 2. 
S(X) INTERPOLATING THE ORDINATES Y(I) AT POINTS X(I), I = Nl 3. 
THROUGH N2. FOR XX IN (X(I),X(I+1)) THE VALUE OF THE SPLINE 4. 
FUNCTION S(XX) IS GIVEN BY THE FIFTH DEGREE POLYNOMIAL: 5. 
S(XX) = ((( (FCI) *T+E(1T) )*T+D(1) )*T+C(1))*T+B(1I))*T+Y(T) 6. 
WITH T = XX - X(T). 1. 
INPUT: 8. 
N1,N2 SUBSCRIPT OF FIRST AND LAST DATA POINT RESPECTIVELY, 9. 
IT IS REQUIRED THAT N2 > N1 +1, 10. 
X,Y(N1l::N2) ARRAYS WITH X(I) AS ABSCISSA AND Y(I) AS ORDINATE ll. 
OF THE I-TH DATA POINT. THE ELEMENTS OF THE ARRAY X 12. 
MUST BE STRICTLY MONOTONE INCREASING (BUT SEE BELOW FOR 13. 
EXCEPTIONS TO THIS). 14. 
OUTPUT: 15. 
B,C,D,E,F(Nl::N2) ARRAYS COLLECTING THE COEFFICIENTS OF THE 16. 
QUINTIC NATURAL SPLINE S(XX) AS DESCRIBED ABOVE. 17. 
SPECIFICALLY B(I) = S'(X(I)), C(I) = S"(X(I))/2, 18. 
D(I) = S""(X(I))/6, E(I) = S""(X(I))/24, 19. 
F(I) = S"""(X(1I)4+0)/120. F(N2) IS NEITHER USED OR 20. 
ALTERED. THE ARRAYS B,C,D,E,F MUST ALWAYS BE DISTINCT. 21. 
OPTIONS: 22. 
1. THE REQUIREMENT THAT THE ELEMENTS OF THE ARRAY X BE 23. 
STRICTLY MONOTONE INCREASING CAN BE RELAXED TO ALLOW TWO 24. 
OR THREE CONSECUTIVE ABSCISSAS TO BE EQUAL AND THEN 25. 
SPECIFYING VALUES OF THE FIRST AND SECOND DERIVATIVES OF 26. 
THE SPLINE FUNCTION AT SOME OF THE INTERPOLATING POINTS. 27. 
SPECIFICALLY 28. 
IF X(J) = X(J+1) THEN S(X(J)) = Y(J) AND S'(X(J)) = Y(J+1), 29. 
IF X(J) = X(J+1) = X(J+2) THEN IN ADDITION S"(X(J)) =Y¥(J+2). 30. 
NOTE THAT S""(X) IS DISCONTINUOUS AT A DOUBLE KNOT AND IN 31. 
ADDITION S"'(X) IS DISCONTINUOUS AT A TRIPLE KNOT. AT A 32. 
DOUBLE KNOT, X(J) = X(J+1), THE OUTPUT COEFFICIENTS HAVE THE 33. 
FOLLOWING VALUES: 34. 
B(J) = S'(X(J)) = B(J+1) 35. 
C(J) = S"(X(J))/2 = C(J+1) 36. 
D(J) = S"'(X(J))/6 = D(J+1) 37. 
E(J) = S""(X(J)-0)/24 E(J+1) S""(X(J)+0)/24 38. 
F(J) = S""'(X(J)-0)/120 F(J+1) s"""'(X(J)4+0)/120 39. 


THE REPRESENTATION OF S(XX) REMAINS VALID IN ALL INTERVALS 40. 
PROVIDED THE REDEFINITION Y(J+1) := Y(J) IS MADE 41. 
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IMMEDIATELY AFTER THE CALL OF THE PROCEDURE QUINAT. AT A 42. 

TRIPLE KNOT, X(J) = X(J+1) = X(J+2), THE OUTPUT COEFFICIENTS 43. 

HAVE THE FOLLOWING VALUES: 44, 

B(J) = S'(X(J)) = B(J+1l) = B(J+2) 45. 

C(J) = S"(X(J))/2 = C(J+1) = C(J+2) 46. 

D(J) = S"'(X(J)-0) /6 D(J+1) = 0 D(d+2) = S"'(X(J)+0)/6 47. 

E(J) = S""(X(J)-0)/24 E(J+1) = 0 E(J+2) = S""(X(J)4+0)/24 48. 

F(J) = S"""*(X(J)-0)/120 F(J+1)=0 F(J+2)=S""'(X(J)4+0)/120 49. 

THE REPRESENTATION OF S(XX) REMAINS VALID IN ALL INTERVALS 50. 
PROVIDED THE REDEFINITION Y(J+2) := Y(J+1) := Y(J) IS MADE 51. 
IMMEDIATELY AFTER THE CALL OF THE PROCEDURE QUINAT. 52. 

2. THE ARRAY X MAY BE MONOTONE DECREASING INSTEAD OF 53. 
INCREASING; 54. 

IF N2 > Nl + 1 THEN 55. 
BEGIN 56. 
INTEGER M; 57. 
REAL B1,P,PQ,PQQR,PR,P2,P3,Q,QR,Q2,Q3,R,R2,S8,T,U,V; 58. 
COMMENT COEFFICIENTS OF A POSITIVE DEFINITE, PENTADIAGONAL 59. 
MATRIX STORED IN D,E,F(N1+1::N2-2); 60. 
M:=N2-2; 61. 
Q:=X(N1+1)-X(N1);  Rs=X(N1+2)-X(N141); 62. 
Q2:=Q*Q; R2:=R*R: QR:=Q+tR; 63. 
D(N1) s=E(N1):=0.0; 64. 
D(N1+1):=IF Q=0.0 THEN 0.0 ELSE 6.0*Q*Q2/(QR*QR); 65. 
FOR I:=N1+1l STEP 1 UNTIL M DO 66. 
BEGIN 67. 
P:=Q; Q:=R; R:=X(I+2)-X(I+1); 68. 
P2:=Q2; Q2:=R2; R2:=R*R; POQ:=QR; QR:=Q+R; 69. 

IF Q=0.0 THEN D(I+1):=E(1I):=F(I-1):=0.0 ELSE 70. 
BEGIN 71. 
Q3:=02*Q; PR:=P*R; PQOR:=PQ*QR; 72. 
D(I+1) :=6.0*Q3/(QR*QR); 73. 

D(I) :=D(I)+(Q+Q)*(15.0*PR*PR+( P+R) *QO*(20.0*PR+7.0*Q2) 74. 
+Q2*(8.0* (P2+R2)+21.0*PR+02+02) )/(PQQR*PQOR); 75. 
D(I-1):=D(I-1)+6.0*0Q3/(PQ*PQ); 76. 

E( I) :=Q2* (P*QR+3.0*PQ* (QR+R+R) )/( PQQR*QR) > 77. 
E(I-1) :=E(I-1)+Q2* (R*PQ+3.0*QR* (PQ+P+P))/(PQQR*PQ); 78. 
F(I-1):=Q3/PQQR; 79. 

END; 80. 
END; 81. 
IF Rv=0.0 THEN D(M) :=D(M)+6.0*R*R2/(QR*OR); 82. 
COMMENT FIRST AND SECOND ORDER DIVIDED DIFFERENCES OF THE GIVEN 83. 
FUNCTION VALUES,STORED IN B(N1+1::N2) AND C(N1+2::N2) 84. 
RESPECTIVELY, TAKE CARE OF DOUBLE AND TRIPLE KNOTS; 85. 
S:=Y(N1); 86. 
FOR I:=N1+1 STEP 1 UNTIL N2 DO 87. 
IF X(I)=X(I-1) THEN B(I):=Y(I) ELSE 88. 
BEGIN 89. 
B(I):=(¥(I)-S)/(X(1I)-X(I-1) ); 90. 
S:=Y(I); 91. 
END; 92. 
FOR I:=N1+2 STEP 1 UNTIL N2 DO 93. 
IF X(1I)=X(I-2) THEN 94. 
BEGIN C(I):=Y(1I)*0.5; B(I):=B(I-1) END 95. 
ELSE C(1):=(B(I)-B(I-1))/(X(1I)-X(1I-2)); 96. 
COMMENT SOLVE THE LINEAR SYSTEM WITH C(I+2)-C(I+1) 97. 
AS RIGHT-HAND SIDE; 98. 

IF M > Nl THEN 99. 
BEGIN 100. 
P:=C(N1) :=E(M):=F(N1) :=F(M-1) :=F(M):=0.0; 101. 
C(N1+1):=C(N1+3)-C(N1+2); D(N1+1):=1.0/D(N141); 102. 
END; 103. 
FOR I:=N1+2 STEP 1 UNTI% M DO 104. 
BEGIN 105. 
Q:=D(I-1)*E(I-1); 106. 
D(I) :=1.0/(D(I)-P*F(I-2)-Q*E(I-1)); 107. 
E(1I):=E(1)-Q*F(I-1); 108. 
C(I) s:=C(1+2)-C(I+1)-P*C(I-2)-Q*C(I-1); 109. 
P:=D(I-1)*F(I-1); 110. 
END; 111. 
M:=N1+1; C(N2-1):=C(N2):=0.0; 112. 
FOR I:=N2-2 STEP -1l UNTIL M DO 113. 
C(I) s=(C(1I)-E(1)*C(I+1)-F(1I)*C(I+2))*D(I); 114. 
COMMENT INTEGRATE THE THIRD DERIVATIVE OF S(X); 115. 
M:=N2-1; 116. 
Q:=X(N1+1)-X(N1)3; R:s=X(N1+2)-X(N1+4+1); Bl:=B(N1+1); 117. 
Q3:=Q*0O*0; QR:=Q+R; 1138. 
V:=T:=IF QR=0.0 THEN 0.0 ELSE C(N1+1)/QR; 119. 
F(N1):=IF Q=0.0 THEN 0.0 ELSE V/Q; 120. 
FOR I:=Nl1+1 STEP 1 UNTIL M DO 121. 
BEGIN 122. 
P:=Q: Q:=R; 123. 
R:=IF I=N2-1 THEN 0.0 ELSE X(I+2)-X(I+1); 124. 


P3:=Q3; Q3:=Q*Q*Q; PQ:=OR; QR:=QtR; 125. 
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S:=T; 
U:=V; V:=T-S; 
IF PQ=0.0 THEN 
BEGIN C(T) 
ELSE 
F(I) 
E(I): 
D(I): 
C(I) 


:=IF Q=0.0 
=5.0%*S; 


T:=IF QR=0. 


:=0.5*Y(I+1): 


0 THEN 0.0 ELSE (C(I+1)-C(I))/OR;: 


D(I):=E(I):=F(I):=0.0 END 


THEN F(I-1) ELSE V/Q; 


=10.0*(C(I)-Q*S); 
:=D(1)*(P-Q)+(B(I+1) 


~B(I)+(U-E(1I))*P3 


-(V+E(T))*Q3)/PQ; 


B(I) 


2=(P*(B(I+1)-V*Q3)+Q*(B(I) 


=U*P3))72Q 


-P*Q* (D(I)+E(I)*(Q-P)); 


END; 
END T; 


COMMENT END POINTS X(N1) AND X(N2); 


P:=X(N1+1)-X(N1); 
E(N1):=D(N1):= 
C(N1):=C(N1+1) 
B(N1):=B1-(C(N1)+S 
Q:=X(N2)-X(N2-1); 
E(N2):=D(N2):=0.0; 
C(N2):=C(N2-1)+410. 
B(N2): 
END QUINAT; 


PROCEDURE QUINEQ( INTEGER VALUE N1,N2; 

COMMENT QUINEQ COMPUTES THE COEFFICIENTS OF A QUINTIC NATURAL SPLINE 
S(X) INTERPOLATING THE ORDINATES Y(I) AT EQUIDISTANT POINTS X(I), 

FOR XX IN 


I = Nl THROUGH N2. 
SPLINE FUNCTION S(XX) 


=F(N1)*P*P*P; 


-10.0*S; 
)*P; 
T:=F(N2-1) *Q*Q*Q; 


O*T; 
=B(N2)+(C(N2)-T) *Q; 


REAL ARRAY Y,B,C,D,E,F(*)); 


(X(I),X(I+1)) THE VALUE OF THE 
IS GIVEN BY THE FIFTH DEGREE POLYNOMIAL: 


S(XX) = ((( (FCI) *T+E(1) )*T+D( 1) )*T+C(1I)) *£T+B(1)) *T+Y(1) 
WITH T = (XX - X(I))/(X(It+1) - X(I)). 
INPUT: 

N1, N2 SUBSCRIPT OF FIRST AND LAST DATA POINT RESPECTIVELY, 
IT IS REQUIRED THAT N2 > N1 +1, 

Y(N1l::N2) THE GIVEN FUNCTION VALUES (ORDINATES). 

OUTPUT: 

B,C,D,E,F(N1::N2) ARRAYS COLLECTING THE COEFFICIENTS OF THE 
QUINTIC NATURAL SPLINE S(XX) AS DESCRIBED ABOVE. 
SPECIFICALLY B(I) = S'(X(I)), C(I) = S"(X(I))/2, 
D(I) = S""(X(I))/6, E(I) = S""(X(1I))/24, 

F(I) = S""'(X(I)+0)/120. F(N2) IS NEITHER USED 
NOR ALTERED. THE ARRAYS Y,B,C,D MUST ALWAYS BE 
DISTINCT, IF E AND F ARE NOT WANTED, THE CALL 
QUINEQ(N1,N2,Y,B,C,D,D,D) MAY BE USED TO SAVE STORAGE 
LOCATIONS; 
IF N2>N1+1 THEN 
BEGIN 
INTEGER N; 
REAL P,Q,R,S,T,U,V; 
N:=N2-3; P:=Q:=R:=S:=T:=0.0; 
FOR I:=Nl1 STEP 1 UNTIL N DO 
BEGIN 
U:=P*R; B(I):=1.0/(66.0-U*R-Q); 
C(I) :=R:=26.0-U; 
D(I):= ga hes a O* (¥(I+2)- Y¥(I+1))-Y(1I)-U*S-Q*T; 
Q:=P; P:=B(I); T:=S; S:=D(T) 
END I; 
D(N+1):=D(N+2):=0.0;3 


FOR I:=N STEP -1 UNTIL Nl DO 


D(I):=(D(I)-C(1I)*D(I+1)-D(I+2))*B(I); 
N:=N2-1l; Q:=0.0; R:=T:=V:=D(NI1); 
FOR I:=Nl1+l STEP 1 UNTIL N DO 
BEGIN 
P:=Q; Q:=R; R:=D(I); S:=T; 
F(I):=T:=P-Q-Q+R; 
E(I):=U:=5.0* (-P+Q); 
D(I):=10.0* (P+Q); 
C(I):=0.5* (Y(I+1)+Y(I-1)+S-T)-Y(1I)-U; 
B(I):=0.5* (¥(I+1)-Y(I-1)-S-T)-D(TI) 
END I; 
F(N1L):=V; E(N1):=E(N2):=D(N1):=D(N2):=0.0; 
C(N1):=C(N14+1)-10.0*V; C(N2):=C(N2-1)+10.0*T; 
B(N1) :=Y(N1+1)-Y(N1)-C(N1)-V; B(N2) :=Y(N2)-Y(N2-1)+C(N2)-T 


END QUINEQ; 


PROCEDURE QUINDF(INTEGER VALUE N1,N2; 
COMMENT QUINDF COMPUTES THE COEFFICIENTS OF A QUINTIC NATURAL SPLINE 


REAL ARRAY X,Y,B,C,D,E,F(*)); 


S(X) FOR WHICH THE ORDINATES Y(I) AND THE FIRST DERIVATIVES B(I) 


ARE SPECIFIED AT POINTS X(I), I = 


Nl THROUGH N2. FOR XX IN 


(X(I),X(I+1)) THE VALUE OF THE SPLINE FUNCTION S(XX) IS GIVEN 


126. 
127. 
128. 
129. 
130. 
131. 
132. 
133. 
134. 
135. 
136. 
137. 
138. 
139. 
140. 
141. 
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150. 
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170. 
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BY THE FIFTH DEGREE POLYNOMIAL: 206. 
S(XX) = ((((F(1L) *T+E(1) )*T4+D(1) )*T+C( 1) )*T+B( 1) ) *T+Y¥(1) 207. 
WITH T = XX - X(I). 208. 
INPUT: 209. 
Nl, N2 SUBSCRIPT OF FIRST AND LAST DATA POINT RESPECTIVELY, 210. 
IT IS REQUIRED THAT N2 > Nl, 211. 
X,Y,B(N1::N2) ARRAYS WITH X(I) AS ABSCISSA, Y(I) AS ORDINATE 212. 
AND B(I) AS FIRST DERIVATIVE AT THE I-TH DATA POINT. 213. 

THE ELEMENTS OF THE ARRAY X MUST BE STRICTLY MONOTONE 214. 
INCREASING OR DECREASING. 215. 

OUTPUT: 216. 
C,D,E,F(N1::N2) ARRAYS COLLECTING THE COEFFICIENTS OF THE 217. 
QUINTIC NATURAL SPLINE S(XX) AS DESCRIBED ABOVE. 218. 

E(N2) AND F(N2) ARE NEITHER USED NOR ALTERED. THE 219. 

ARRAYS C,D,E,F MUST ALWAYS BE DISTINCT; 220. 

IF N2 > Nl THEN 221. 
BEGIN 222. 
INTEGER M2; 223. 
REAL CC,G,H,HH,H2,HH2,P,PP,0,00,R,RR; 224. 
M2:=N2-1; CC:=HH:=PP:=QQ:=RR:=G:=0.0; 225. 
FOR IT:=N]1 STEP 1 UNTIL M2 DO 2.26. 
BEGIN 227. 
Hs=1.0/(X(I+1)-X(1I)); H2:=H*H; D(I):=3.0*(HH+H) - G*HH; 228. 
Ps=(Y¥(I+1)-Y(1I))*H*H2; Q:=(B(I+1)+B(I))*H2; 229. 
R:=(B(I+1)-B(1))*H2; 230. 
C(I):=CC:=10.0*(P-PP) - 5.0*(0-QQ) + R + RR + G*CC; 231. 
G:=H/D(I); HH:=H; HH2:=H2; PP:=P; QQ:=Q; RR:=R 232. 
END IT; 233. 
C(N2):=(-10.0*PP + 5.0*0Q + RR + G*CC)/(3.0*HH - G*HH); 234. 
FOR I:=M2 STEP -l UNTIL Nl DO 235. 
BEGIN 236. 
D(I+1):=1.0/(X(1I+1)-X(1)); C(I):=(C(1I) + C(I+1)*D(1I+1))/D(T1) 237. 
END I; 238. 
FOR I:=N1 STEP 1 UNTIL M2 DO 239. 
BEGIN 240. 
H:=D(I+1); H2:=H*H; 241. 
P:=(Y(I+t1)-Y(1))*H*H2 - B(I)*H2 -C(1I)*H; 242. 
Q:=(B(I+1)-B(I))*H2 - C(1I)*(H+H); 243. 
R:=(C(I+1)-C(1))*H; 244, 
G:=Q —- 3.0*P; RR:=R - 3.0*(P+G); QQ:= -RR - RR + G; 245. 
F(I):=RR*H2; E(1):=QQ*H; D(I):= -RR - QQ + P 246. 
END I; 247. 
D(N2):=0.0 248. 
END QUINDF; 249. 
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Procedures for Quintic Natural Spline Interpolation 
[J.G. Herriot and C.H. Reinsch, ACM Trans. Math. Softw. 2, 3 (June 1976), 
281-289. ] 


R.J. Hanson [Received 10 March 1982; accepted 10 March 1982] 
Numerical Mathematics Division 5642, Sandia National Laboratories, Albuquer- 
que, NM 87185 


Line number 82. of Algorithm 507 

IF R 7= 0.0 THEN D(M) := D(M) + 6.0*R+*R2/(QR*QR) 

is changed to the mathematically equivalent line 

IF ABS(R) > 0.0 THEN D(M) := D(M) + 6.0*R+*R2/(QR*QR) 


The change is made for this reason: the character “—’ will often not transmit 
correctly in the Collected Algorithms from ACM distribution process. 
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ALGORITHM 508 
Matrix Bandwidth and Profile Reduction | Fl] 


H. L. CRANE JR. 

Comptek Research, Inc. 

NORMAN‘ E. GIBBS, WILLIAM G. POOLE JR., and PAUL K. STOCKMEYER 
College of William and Mary 


Key Words and Phrases: bandwidth reduction, diameter of a graph, profile reduction, 
sparse matrices 

CR Categories: 5.14, 5.32 

Language: Fortran 


DESCRIPTION 
Introduction 


This program, REDUCE, reduces the bandwidth and profile of sparse symmetric 
matrices, using row and corresponding column permutations. It is a realization of 
the algorithm described by the authors in [4]. It was extensively tested and com- 
pared with several other programs [5] and was found to be considerably faster than 
the others, generally superior for bandwidth reduction and as satisfactory as any 
other for profile reduction. 


Outline of the Method 

Only an outline of the algorithm is given here; a detailed description can be found 
in [4]. The algorithm can best be described in terms of the adjacency graph G, which 
has the characteristic that there is an cdge in G between vertices v; and v; if and 
only if a;; ¥ O and? # j. 

Step 1. Find the endpoints of a pseudodiameter, i.c. a pair of vertices that are at 
nearly maximal distance apart. This is donc by a finite, iterative process of deter- 
mining a vertex that is a maximum distance away from a given vertex. 

Step 2. Given pscudodiameter endpoints wu and v of distance k apart, partition 
the set of vertices into levels L,, Le,..., Ly such that adjacent vertices in G are 
in the same or adjacent levels and such that max; | L; | is nearly minimized. 

Step 3. Number the vertices of G, level by level, beginning at an endpoint of the 
pseudodiameter. 


Matrix Data Structure 


Sparse matrices are typically stored in some compact form which takes advantage 
of the sparsity. The data structure assumed here is one which is commonly used in 
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bandwidth and profile schemes, e.g. [1], [2], [3], and [6]. Subroutine REDUCE ac- 
cepts as input a connection table, C’, representing the indices of the nonzero elements 
of the nXn matrix A. The connection table has n rows and m columns where m 
is the number of off-diagonal nonzero elements in the row which has a maximum 
number of off-diagonal nonzero elements (i.e. the maximum degree of the graph 
G). The entries in row 7 of C are the column indices of the nonzero elements in row 7 
of the matrix A. For example, if 


250 


120 
The order of indices in a row of C is immaterial. The nonzero elements of the matrix 
A are never needed, only their indices. 


Test Results 


REDUCE was tested on an IBM System/360 (model 50) computer using the 
Fortran IV G and H compilers and on a CDC 6600 computer using the Fortran 
(RUN) and Fortran extended (FTN) compilers. 

In another paper [5], the authors compared the execution times, bandwidths, and 
profiles produced by REDUCE with those of five other programs on a wide range 
of problems. REDUCE typically produced the smallest bandwidths; it produced 
profiles which were on the average as small as those for any other program; and 
REDUCE was faster than all the others by at least an order of magnitude. 
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ALGORITHM 
SUBROUTINE REDUCE(NDSTK, NR, IOLD, RENUM, NDEG, LVL, LVLS1, RED 1 
* LVLS2, CCSTOR, IBW2, IPF2) RED 26 
C SUBROUTINE REDUCE DETERMINES A ROW AND COLUMN PERMUTATION WHICH, RED 30 
C WHEN APPLIED TO A GIVEN SPARSE MATRIX, PRODUCES A PERMUTED RED 4¢ 
C MATRIX WITH A SMALLER BANDWIDTH AND PROFILE. RED 50 
C THE INPUT ARRAY IS A CONNECTION TABLE WHICH REPRESENTS THE RED 60 
C INDICES OF THE NONZERO ELEMENTS OF THE MATRIX, A. THE ALGO- RED 76 
C RITHM IS DESCRIBED IN TERMS OF THE ADJACENCY GRAPH WHICH RED 80 
C HAS THE CHARACTERISTIC THAT THERE IS AN EDGE (CONNECTION) RED 99 
C BETWEEN NODES I AND J IF A(I,J) .NE. @ AND I .NE. J. RED 100 
C DIMENSIONING INFORMATION--THE FOLLOWING INTEGER ARRAYS MUST BE RED 110 
C DIMENSIONED IN THE CALLING ROUTINE. RED 126 
C -NDSTK(NR,D1) Dl IS .GE. MAXIMUM DEGREE OF ALL NODES. RED 130 
C LOLD (D2) D2 AND NR ARE .GE. THE TOTAL NUMBER OF RED 149 
C RENUM(D2+1) NODES IN THE GRAPH. RED 150 
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NDEG (D2) STORAGE REQUIREMENTS CAN BE SIGNIFICANTLY 
LVL(D2) DECREASED FOR IBM 36@ AND 37@ COMPUTERS 
LVLS1 (D2) BY REPLACING INTEGER NDSTK BY 

LVLS2 (D2) INTEGER*2 NDSTK IN SUBROUTINES REDUCE, 
CCSTOR (D2) DGREE, FNDIAM, TREE AND NUMBER. 


COMMON INFORMATION--THE FOLLOWING COMMON BLOCK MUST BE IN THE 
CALLING ROUTINE. 
COMMON /GRA/N , IDPTH, IDEG 
EXPLANATION OF INPUT VARIABLES-- 
NDSTK- CONNECTION TABLE REPRESENTING GRAPH. 
NDSTK(I,J)=NODE NUMBER OF JTH CONNECTION TO NODE 
NUMBER I. A CONNECTION OF A NODE TO ITSELF IS NOT 
LISTED. EXTRA POSITIONS MUST HAVE ZERO FILL. 
NR- ROW DIMENSION ASSIGNED NDSTK IN CALLING PROGRAM. 
IOLD(I)- NUMBERING OF ITH NODE UPON INPUT. 
IF NO NUMBERING EXISTS THEN IOLD(I)=I1. 
N- NUMBER OF NODES IN GRAPH (EQUAL TO ORDER OF MATRIX). 
IDEG- MAXIMUM DEGREE OF ANY NODE IN THE GRAPH. 
EXPLANATION OF OUTPUT VARIABLES-- 
RENUM(I)- THE NEW NUMBER FOR THE ITH NODE.. 
NDEG(I)- THE DEGREE OF THE ITH NODE. 


IBW2- THE BANDWIDTH AFTER RENUMBERING. 
IPF2- THE PROFILE AFTER RENUMBERING. 
IDPTH- NUMBER OF LEVELS IN REDUCE LEVEL STRUCTURE. 
THE FOLLOWING ONLY HAVE MEANING IF THE GRAPH WAS CONNECTED-- 
LVL(I)- INDEX INTO LVLS1 TO THE FIRST NODE IN LEVEL I. 
LVL (I+1)-LVL(1I)= NUMBER OF NODES IN ITH LEVEL 
LVLS1- NODE NUMBERS LISTED BY LEVEL. 


LVLS2(I)- THE LEVEL ASSIGNED TO NODE I BY REDUCE. 
WORKING STORAGE VARIABLE-- 
CCSTOR 
LOCAL STORAGE--- 
COMMON/CC/-SUBROUTINES REDUCE, SORT2 AND PIKLVL ASSUME THAT 
THE GRAPH HAS AT MOST 5@ CONNECTED COMPONENTS. 
SUBROUTINE FNDIAM ASSUMES THAT THERE ARE AT MOST 
1¢@@ NODES IN THE LAST LEVEL. 
COMMON/LVLW/-SUBROUTINES SETUP AND PIKLVL ASSUME THAT THERE 
ARE AT MOST 1¢¢ LEVELS. 
USE INTEGER*2 NDSTK WITH AN IBM 360 OR 37¢@. 
INTEGER NDSTK 
INTEGER STNODE, RVNODE, RENUM, XC, SORT2, STNUM, CCSTOR, 
* SIZE, STPT, SBNUM 
COMMON /GRA/ N, IDPTH, IDEG 
IT IS ASSUMED THAT THE GRAPH HAS AT MOST 5@ CONNECTED COMPONENTS. 
COMMON /CC/ XC, SIZE(5@), STPT(5@) 
COMMON /LVLW/ NHIGH(1@¢@), NLOW(1@@) , NACUM(1@@) 
DIMENSION CCSTOR(1), IOLD(1) 
DIMENSION NDSTK(NR,1), LVL(1), LVLS1(1), LVLS2(1), RENUM(1), 
* NDEG(1) 
IBW2 = @ 
IPF2 = @ 
SET RENUM(1)=@ FOR ALL I TO INDICATE NODE I IS UNNUMBERED 
pO 1¢ I=1,N 
RENUM(I) = @ 
1@ CONTINUE 
COMPUTE DEGREE OF EACH NODE AND ORIGINAL BANDWIDTH AND PROFILE 
CALL DGREE(NDSTK, NR, NDEG, IOLD, IBWl, IPF1) 
SBNUM= LOW END OF AVAILABLE NUMBERS FOR RENUMBERING 
STNUM= HIGH END OF AVAILABLE NUMBERS FOR RENUMBERING 
SBNUM = 1 
STNUM = N 
NUMBER THE NODES OF DEGREE ZERO 
DO 2@ I=1,N 
IF (NDEG(I).GT.6) GO TO 2 
RENUM(L) = STNUM 
STNUM = STNUM - 1 
2¢ CONTINUE 
FIND AN UNNUMBERED NODE OF MIN DEGREE TO START ON 
3@ LOWDG = IDEG + 1 
NFLG = 1 
ISDIR = 1 
DO 4@ I=1,N 
IF (NDEG(I).GE.LOWDG) GO TO 4@ 
IF (RENUM(I).GT.6) GO TO 4¢ 
LOWDG = NDEG(1) 
STNODE = I 
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4@ CONTINUE 
FIND PSEUDO-DIAMETER AND ASSOCIATED LEVEL STRUCTURES. 


STNODE AND RVNODE ARE THE ENDS OF THE DIAM AND LVLS1 AND LVLS2 


ARE THE RESPECTIVE LEVEL STRUCTURES. 


CALL FNDIAM(STNODE, RVNODE, NDSTK, NR, NDEG, LVL, LVLS1, 


* LVLS2, CCSTOR, IDFLT) 
IF (NDEG(STNODE) .LE.NDEG(RVNODE)) GO TO 5@ 
NFLG INDICATES THE END TO BEGIN NUMBERING ON 
NFLG = -1 
STNODE = RVNODE 
5@ CALL SETUP(LVL, LVLS1, LVLS2) 
FIND ALL THE CONNECTED COMPONENTS (XC COUNTS THEM) 
XC = @ 
LROOT = 1 
LVLN = 1 
DO 6¢@ I=1,N 
IF (LVL(I).NE.@) GO TO 6¢ 
XC = XC + 1 
STPT(XC) = LROOT 


CALL TREE(I, NDSTK, NR, LVL, CCSTOR, NDEG, LVLWTH, LVLBOT, 


*  LVLN, MAXLW, N) 
SIZE(XC) = LVLBOT + LVLWTH - LROOT 
LROOT = LVLBOT + LVLWTH 
LVLN = LROOT 
6@ CONTINUE 
IF (SORT2(DMY) .EQ.@) GO TO 7¢ 
CALL PIKLVL(LVLS?, LVLS2, CCSTOR, IDFLT, ISDIR) 


ON RETURN FROM PIKLVL, ISDIR INDICATES THE DIRECTION THE LARGEST 
COMPONENT FELL. ISDIR IS MODIFIED NOW TO INDICATE THE NUMBERING 
DIRECTION. NUM IS SET TO THE PROPER VALUE FOR THIS DIRECTION. 


7@ ISDIR = ISDIR*NFLG 
NUM = SBNUM 
IF (ISDIR.LT.@) NUM = STNUM 


CALL NUMBER(STNODE, NUM, NDSTK, LVLS2, NDEG, RENUM, LVLS1, 


* LVL, NR, NFLG, IBW2, IPF2, CCSTOR, ISDIR) 
UPDATE STNUM OR SBNUM AFTER NUMBERING 
IF (ISDIR.LT.6) STNUM = NUM 
IF (ISDIR.GT.6) SBNUM = NUM 
IF (SBNUM.LE.STNUM) GO TO 3¢ 
IF (IBW2.LE.IBW1) RETURN 


IF ORIGINAL NUMBERING IS BETTER THAN NEW ONE, SET UP TO RETURN IT 


DO 8¢ I=1,N 
RENUM(1) = IOLD(LI) 
8¢@ CONTINUE 


IBW2 = IBW1 
IPF2 = IPF1 
RETURN 

END 


SUBROUTINE DGREE(NDSTK, NR, NDEG, IOLD, IBWl, IPF1) 
DGREE COMPUTES THE DEGREE OF EACH NODE IN NDSTK AND STORES 


IT IN THE ARRAY NDEG. THE BANDWIDTH AND PROFILE FOR THE ORIGINAL 


OR INPUT RENUMBERING OF THE GRAPH IS COMPUTED ALSO. 
USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370. 
INTEGER NDSTK 
COMMON /GRA/ N, IDPTH, IDEG 
DIMENSION NDSTK(NR,1), NDEG(1), IOLD(1) 
IBWl = @ 
IPF1l = @ 
DO 4@ I=1,N 
NDEG(I) = @ 
IRW = @ 
DO 2¢ J=1,IDEG 
ITST = NDSTK(I,J) 
IF (ITST) 36, 30, 10 
1¢ NDEG(I) = NDEG(I) + 1 
IDIF = IOLD(I) - IOLD(ITST) 
IF (IRW.LT.IDIF) IRW = IDIF 
2@ CONTINUE 
3@ IPFl = IPFl + IRW 
IF (IRW.GT.IBW1) IBW1 = IRW 
46 CONTINUE 
RETURN 
END 
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SUBROUTINE FNDIAM(SND1, SND2, NDSTK, NR, NDEG, LVL, LVLS1, FND 1¢ 

* LVLS2, IWK, IDFLT) FND 2¢ 

C FNDIAM IS THE CONTROL PROCEDURE FOR FINDING THE PSEUDO-DIAMETER OF FND 30 
C NDSTK AS WELL AS THE LEVEL STRUCTURE FROM EACH END FND 4@ 
C SNDI- ON INPUT THIS IS THE NODE NUMBER OF THE FIRST FND 50 
C ATTEMPT AT FINDING A DIAMETER. ON OUTPUT IT FND 6@ 
Cc CONTAINS THE ACTUAL NUMBER USED. FND 70 
C SND2- ON OUTPUT CONTAINS OTHER END OF DIAMETER FND 8@ 
C LVLS1- ARRAY CONTAINING LEVEL STRUCTURE WITH SND1 AS ROOT FND 9¢ 
C LVLS2- ARRAY CONTAINING LEVEL STRUCTURE WITH SND2 AS ROOT FND 16¢ 
C IDFLT- FLAG USED IN PICKING FINAL LEVEL STRUCTURE, SET FND 1106 
Cc =1 IF WIDTH OF LVLS1] .LE. WIDTH OF LVLS2, OTHERWISE =2 FND 12@ 
C LVL, IWK- WORKING STORAGE FND 130 
C USE INTEGER*2 NDSTK WITH AN IBM 36@ OR 37¢@. FND 140 
INTEGER NDSTK FND 150 
INTEGER FLAG, SND, SND1, SND2 FND 160 
COMMON /GRA/ N, IDPTH, IDEG FND 170 

C IT IS ASSUMED THAT THE LAST LEVEL HAS AT MOST 100 NODES. FND 18¢@ 
COMMON /CC/ NDLST(1¢@) FND 190 
DIMENSION NDSTK(NR,1), NDEG(1), LVL(1), LVLS1(1), LVLS2(1), FND 200 

* IWK(1) FND 21¢ 

FLAG = @ FND 2206 

MTW2 = N FND 23 

SND = SND1 FND 24¢ 

C ZERO LVL TO INDICATE ALL NODES ARE AVAILABLE TO TREE FND 25¢ 
16 DO 20 I=1,N FND 260 
LVL(L) = @ FND 27¢ 

2@ CONTINUE FND 28¢@ 
LVLN = 1 FND 296 

C DROP A TREE FROM SND FND 306 
CALL TREE(SND, NDSTK, NR, LVL, IWK, NDEG, LVLWTH, LVLBOT, FND 310 

* LVLN, MAXLW, MTW2) FND 320 

IF (FLAG.GE.1) GO TO 5¢ FND 330 

FLAG = 1 FND 34¢ 

36 IDPTH = LVLN - 1 FND 350 
MTW1 = MAXLW FND 360 

C COPY LEVEL STRUCTURE INTO LVLSI1 FND 37¢ 
DO 4@ I=1,N FND 38¢ 
LVLS1(I) = LVL(I) FND 39¢ 

40 CONTINUE FND 40¢ 
NDXN = 1 FND 41 

NDXL = @ FND 426 

MTW2 = N FND 4306 

C SORT LAST LEVEL BY DEGREE AND STORE IN NDLST FND 440 
CALL SORTDG(NDLST, IWK(LVLBOT), NDXL, LVLWTH, NDEG) FND 45¢ 

SND = NDLST(1) FND 46@ 

GO TO 1¢ FND 47¢ 

50 IF (IDPTH.GE.LVLN-1) GO TO 6¢@ FND 48¢@ 

C START AGAIN WITH NEW STARTING NODE FND 496 
SND1 = SND FND 5@@ 

GO TO 3¢ FND 510 

60 IF (MAXLW.GE.MTW2) GO TO 8@ FND 520 
MTW2 = MAXLW FND 53¢@ 

SND2 = SND FND 54@ 

C STORE NARROWEST REVERSE LEVEL STRUCTURE IN LVLS2 FND 55@ 
DO 70 I=1,N FND 560 
LVLS2(I) = LVL(I) FND 570 

7@ CONTINUE FND 589 

8¢ IF (NDXN.EQ.NDXL) GO TO 9@ FND 59¢ 

C TRY NEXT NODE IN NDLST FND 606¢ 
NDXN = NDXN + 1 FND 61¢ 

SND = NDLST(NDXN) FND 62@ 

GO TO 1 FND 630 

9% IDFLT = 1 FND 64¢@ 

IF (MIW2.LE.MTW1) IDFLT = 2 FND 65¢ 
RETURN FND 660 

END FND 670 
SUBROUTINE TREE(IROOT, NDSTK, NR, LVL, IWK, NDEG, LVLWTH, TRE 16 

* LVLBOT, LVLN, MAXLW, IBORT) TRE 20 

C TREE DROPS A TREE IN NDSTK FROM IROOT TRE 30 
Cc LVL- ARRAY INDICATING AVAILABLE NODES IN NDSTK WITH ZERO TRE 4@ 


C ENTRIES. TREE ENTERS LEVEL NUMBERS ASSIGNED TRE 50 
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Cc 
C 
C 
C 
C 
C 
C 
C 
C 
Cc 
Cc 
C 
C 
C 
C 


DURING EXECUTION OF THIS PROCEDURE 


IWK- ON OUTPUT CONTAINS NODE NUMBERS USED IN TREE 


ARRANGED BY LEVELS (IWK(LVLN) CONTAINS IROOT 
AND IWK(LVLBOT+LVLWIH-1) CONTAINS LAST NODE ENTERED) 


LVLWTH- ON OUTPUT CONTAINS WIDTH OF LAST LEVEL 

LVLBOT- ON OUTPUT CONTAINS INDEX INTO IWK OF FIRST 
NODE IN LAST LEVEL 

MAXLW- ON OUTPUT CONTAINS THE MAXIMUM LEVEL WIDTH 

LVLN- ON INPUT THE FIRST AVAILABLE LOCATION IN IWK 


USUALLY ONE BUT IF IWK IS USED TO STORE PREVIOUS 
CONNECTED COMPONENTS, LVLN IS NEXT AVAILABLE LOCATION. 
ON OUTPUT THE TOTAL NUMBER OF LEVELS + 1 


IBORT- INPUT PARAM WHICH TRIGGERS EARLY RETURN IF 


USE 


19 
2 


36 


MAXLW BECOMES .GE. IBORT 
INTEGER*2 NDSTK WITH AN IBM 360 OR 370. 
INTEGER NDSTK 
DIMENSION NDSTK(NR,1), LVL(1), IWK(1), NDEG(1) 
MAXLW = @ 


LVLN = 1 
LVL(IROOT) = 1 
IWK(ITOP) = IROOT 
LVLN = LVLN + 1 
IWKNOW = IWK(INOW) 
NDROW = NDEG(IWKNOW) 
DO 3¢@ J=1,NDROW 
ITEST = NDSTK(IWKNOW, J) 
IF (LVL(ITEST) .NE.@) GO TO 3@ 
LVL(ITEST) = LVLN 
ITOP = ITOP + 1 
IWK(ITOP) = ITEST 
CONTINUE 
INOW = INOW + 1 
IF (INOW.LT.LVLTOP) GO TO 2¢ 
LVLWTH = LVLTOP - LVLBOT 
IF (MAXLW.LT.LVLWTH) MAXLW = LVLWTH 
IF (MAXLW.GE.IBORT) RETURN 
IF (ITOP.LT.LVLTOP) RETURN 
LVLBOT = INOW 
LVLTOP = ITOP + 1 
GO TO 1¢ 
END 


SUBROUTINE SORTDG(STK1, STK2, Xl, X2, NDEG) 


C SORTDG SORTS STK2 BY DEGREE OF THE NODE AND ADDS IT TO THE END 
C OF STK1 IN ORDER OF LOWEST TO HIGHEST DEGREE. X1 AND X2 ARE THE 
C NUMBER OF NODES IN STKI1 AND STK2Z RESPECTIVELY. 


1 


20 
30 


4@ 


INTEGER Xl, X2, STK1, STK2, TEMP 
COMMON /GRA/ N, IDPTH, IDEG 
DIMENSION NDEG(1), STK1(1), STK2(1) 
IND = X2 
ITEST = @ 
IND = IND - 1 
IF (IND.LT.1) GO TO 3¢ 
DO 2¢ I=1,IND 
J=I+1 
ISTK2 = STK2(I) 
JSTK2 = STK2(J) 
IF (NDEG(ISTK2) .LE.NDEG(JSTK2)) GO TO 2@ 
ITEST = 1 
TEMP = STK2(1) 
STK2(I) = STK2(J) 
STK2(J) = TEMP 
CONTINUE 
IF (ITEST.EQ.1) GO TO 16 
DO 4@ I=1,x2 
Xl = Xl+1 
STKI(X1) = STK2(I) 
CONTINUE 
RETURN 
END 


SOR 
SOR 
SOR 
SOR 


SOR 
SOR 


SOR 
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C IT IS ASSUMED THAT THE GRAPH HAS AT MOST 5@ CONNECTED COMPONENTS. 
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SUBROUTINE SETUP(LVL, LVLS1, LVLS2) 


SETUP COMPUTES THE REVERSE LEVELING INFO FROM LVLS2 AND STORES 
IT INTO LVLS2. NACUM(I) IS INITIALIZED TO NODES/ITH LEVEL FOR NODES 
ON THE PSEUDO-DIAMETER OF THE GRAPH. LVL IS INITIALIZED TO NON- 


ZERO FOR NODES ON THE PSEUDO-DIAM AND NODES IN A DIFFERENT 
COMPONENT OF THE GRAPH. 
COMMON /GRA/ N, IDPTH, IDEG 
IT IS ASSUMED THAT THERE ARE AT MOST 1¢@ LEVELS. 
COMMON /LVLW/ NHIGH(100), NLOW(100), NACUM(14@) 
DIMENSION LVL(1), LVLS1(1), LVLS2(1) 
DO 1¢ I=1,IDPTH 
NACUM(I) = @ 
16 CONTINUE 
DO 3@ I=1,N 
LVL(I) = 1 
LVLS2(1) = IDPTH + 1 - LVLS2(I) 
ITEMP = LVLS2(1) 
IF (ITEMP.GT.IDPTH) GO TO 3@ 
IF (ITEMP .NE.LVLS1(1)) GO TO 2@ 
NACUM(ITEMP) = NACUM(ITEMP) + 1 
GO TO 3¢ 
20 LVL(I) = @ 
30 CONTINUE 
RETURN 
END 


INTEGER FUNCTION SORT2(DMY) 
SORT2 SORTS SIZE AND STPT INTO DESCENDING ORDER ACCORDING TO 
VALUES OF SIZE. XC=NUMBER OF ENTRIES IN EACH ARRAY 

INTEGER TEMP, CCSTOR, SIZE, STPT, XC 


COMMON /CC/ XC, SIZE(5@), STPT(50) 
SORT2 = @ 
IF (XC.EQ.@) RETURN 
SORT2 = 1 
IND = XC 
16 ITEST = @ 
IND = IND - 1 
IF (IND.LT.1) RETURN 
DO 2¢@ I=1,IND 
fh Ae T 
IF (SIZE(I).GE.SIZE(J)) GO TO 2¢ 
ITEST = 1 
TEMP = SIZE(I) 
SIZE(I) = SIZE(J) 
SIZE(J) = TEMP 
TEMP = STPT(I) 
STPT(I) = STPT(J) 
STPT(J) = TEMP 
2@ CONTINUE 
IF (ITEST.EQ.1) GO TO 1¢ 
RETURN 
END 


SUBROUTINE PIKLVL(LVLS1, LVLS2, CCSTOR, IDFLT, ISDIR) 
PIKLVL CHOOSES THE LEVEL STRUCTURE USED IN NUMBERING GRAPH 


LVLS1- ON INPUT CONTAINS FORWARD LEVELING INFO 
LVLS2- ON INPUT CONTAINS REVERSE LEVELING INFO 
ON OUTPUT THE FINAL LEVEL STRUCTURE CHOSEN 
CCSTOR- ON INPUT CONTAINS CONNECTED COMPONENT INFO 
IDFLT- ON INPUT =1 IF WDTH LVLS1.LE.WDTH LVLS2, =2 OTHERWISE 
NHIGH KEEPS TRACK OF LEVEL WIDTHS FOR HIGH NUMBERING 
NLOW- KEEPS TRACK OF LEVEL WIDTHS FOR LOW NUMBERING 
NACUM- KEEPS TRACK OF LEVEL WIDTHS FOR CHOSEN LEVEL STRUCTURE 
XC- NUMBER OF CONNECTED COMPONENTS 
SIZE(I)- SIZE PF ITH CONNECTED COMPONENT 
STPT(I)- INDEX INTO CCSTORE OF 1ST NODE IN ITH CON COMPT 
ISDIR- FLAG WHICH INDICATES WHICH WAY THE LARGEST CONNECTED 


COMPONENT FELL. =+l IF LOW AND ~1 IF HIGH 
INTEGER CCSTOR, SIZE, STPT, XC, END 
COMMON /GRA/ N, IDPTH, IDEG 
IT IS ASSUMED THAT THE GRAPH HAS AT MOST 5@ COMPONENTS AND 
THAT THERE ARE AT MOST 10@ LEVELS. 


SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 
SET 


SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 
SOR 


SOR 
SOR 


PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
PIK 
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COMMON /LVLW/ NHIGH(16¢), NLOW(160), NACUM(100) 
COMMON /CC/ XC, SIZE(5@), STPT(5@) 
DIMENSION LVLS1(1), LVLS2(1), CCSTOR(1) 
FOR EACH CONNECTED COMPONENT DO 
DO 8¢ I=1,xC 
J = STPT(L) 
END = SIZE(I) + J - 1 
SET NHIGH AND NLOW EQUAL TO NACUM 
DO 1@ K=1,IDPTH 
NHIGH(K) = NACUM(K) 
NLOW(K) = NACUM(K) 
19 CONTINUE 
UPDATE NHIGH AND NLOW FOR EACH NODE IN CONNECTED COMPONENT 
DO 2¢ K=J,END 
INODE = CCSTOR(K) 
LVLNH = LVLS1(INODE) 
NHIGH(LVLNH) = NHIGH(LVLNH) + 1 
LVLNL = LVLS2(INODE) 
NLOW(LVLNL) = NLOW(LVLNL) + 1 
260 CONTINUE 
MAX1 = @ 
MAX2 = @ 
SET MAX1=LARGEST NEW NUMBER IN NHIGH 
SET MAX2=LARGEST NEW NUMBER IN NLOW 
DO 3@ K=1,IDPTH 
IF (2*NACUM(K) .EQ.NLOW(K)+NHIGH(K)) GO TO 3¢ 
IF (NHIGH(K) .GT.MAX1) MAX1 = NHIGH(K) 
IF (NLOW(K) .GT.MAX2) MAX2 = NLOW(K) 
3@ CONTINUE 
SET IT= NUMBER OF LEVEL STRUCTURE TO BE USED 
IT=1 
IF (MAX1.GT.MAX2) IT 
IF (MAX1.EQ.MAX2) IT 
IF (IT.EQ.2) GO TO 6¢ 
IF (1.EQ.1) ISDIR = -1 
COPY LVLS1 INTO LVLS2 FOR EACH NODE IN CONNECTED COMPONENT 
DO 4@ K=J,END 
INODE = CCSTOR(K) 
LVLS2(INODE) = LVLS1(INODE) 
46 CONTINUE 
UPDATE NACUM TO BE THE SAME AS NHIGH 
DO 5@ K=1,IDPTH 
NACUM(K) = NHIGH(K) 
50 CONTINUE 
GO TO 8¢ 
UPDATE NACUM TO BE THE SAME AS NLOW 
6@ DO 7¢ K=1,IDPTH 
NACUM(K) = NLOW(K) 
7@ CONTINUE 
8@ CONTINUE 
RETURN 
END 


2 
IDFLT 


SUBROUTINE NUMBER(SND, NUM, NDSTK, LVLS2, NDEG, RENUM, LVLST, 


* LSTPT, NR, NFLG, IBW2, IPF2, IPFA, ISDIR) 
NUMBER PRODUCES THE NUMBERING OF THE GRAPH FOR MIN BANDWIDTH 


SND- ON INPUT THE NODE TO BEGIN NUMBERING ON 
NUM- ON INPUT AND OUTPUT, THE NEXT AVAILABLE NUMBER 
LVLS2- THE LEVEL STRUCTURE TO BE USED IN NUMBERING 
RENUM-~ THE ARRAY USED TO STORE THE NEW NUMBERING 
LVLST- ON OUTPUT CONTAINS LEVEL STRUCTURE 
LSTPT(1)- ON OUTPUT, INDEX INTO LVLST TO FIRST NODE IN ITH LVL 
LSTPT(I+1) - LSTPT(L) = NUMBER OF NODES IN ITH LVL 
NFLG- =+] IF SND IS FORWARD END OF PSEUDO-DIAM 
=-1 IF SND IS REVERSE END OF PSEUDO-DIAM 
IBW2- BANDWIDTH OF NEW NUMBERING COMPUTED BY NUMBER 
IPF2- PROFILE OF NEW NUMBERING COMPUTED BY NUMBER 
IPFA- WORKING STORAGE USED TO COMPUTE PROFILE AND BANDWIDTH 
ISDIR- INDICATES STEP DIRECTION USED IN NUMBERING(+1 OR -1) 


USE INTEGER*2 NDSTK WITH AN IBM 36@ OR 37@. 
INTEGER NDSTK 


INTEGER SND, STKA, STKB, STKC, STKD, XA, XB, XC, XD, CX, END, 


* RENUM, TEST 
COMMON /GRA/ N, IDPTH, IDEG 
THE STORAGE IN COMMON BLOCKS CC AND LVLW IS NOW FREE AND CAN 
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BE USED FOR STACKS. 
COMMON /LVLW/ STKA(160), STKB(10@), STKC (100) 
COMMON /CC/ STKD(16@) 
DIMENSION IPFA(1L) 
DIMENSION NDSTK(NR,1), LYLS2(1), NDEG(1), Sea LVLST(1), 
* LSTPT(1) 
SET UP LVLST AND LSTPT FROM LVLS2 
DO 1¢@ I=1,N 
IPFA(I) = @ 
1@ CONTINUE 
NSTPT = 1 
DO 3@ I=1,IDPTH 
LSTPT(I) = NSTPT 
DO 2¢ J=1,N 
IF (LVLS2(J).NE.I) GO TO 20 
LVLST(NSTPT) = J 
NSTPT = NSTPT + 1 
26 CONTINUE 
36 CONTINUE 
LSTPT(IDPTH+1) = NSTPT 
STKA, STKB, STKC AND STKD ARE STACKS WITH POINTERS 
XA,XB,XC, AND XD. CX IS A SPECIAL POINTER INTO STKC WHICH 
INDICATES THE PARTICULAR NODE BEING PROCESSED. 
LVLN KEEPS TRACK OF THE LEVEL WE ARE WORKING AT. 
INITIALLY STKC CONTAINS ONLY THE INITIAL NODE, SND. 


LVLN = @ 
IF (NFLG.LT.@) LVLN = IDPTH + 1 
XC = 1 
STKC(XC) = SND 
40 os = 1 
@ 


ain = LVLN + NFLG 
LST = LSTPT(LVLN) 
LND = LSTPT(LVLN+1) - 1 
BEGIN PROCESSING NODE STKC (CX) 
5@ IPRO = STKC(CX) 
RENUM(IPRO) = NUM 


NUM = NUM + ISDIR 

END = NDEG(IPRO) 
= 6 

XB = @ 


CHECK ALL ADJACENT NODES 
DO 8¢ I=1,END 
TEST = NDSTK(IPRO,1) 
INX = RENUM(TEST) 
ONLY NODES NOT NUMBERED OR ALREADY ON A STACK ARE ADDED 
IF (INX.EQ.@) GO TO 6¢ 
IF (INX.LT.6) GO TO 8¢@ 
DO PRELIMINARY BANDWIDTH AND PROFILE CALCULATIONS 
NBW = (RENUM(IPRO)-INX)*ISDIR 
IF (ISDIR.GT.@) INX = RENUM(IPRO) 
IF (IPFACINX).LT.NBW) IPFA(INX) = NBW 
GO TO 8¢ 
60  RENUM(TEST) = -1 
PUT NODES ON SAME LEVEL ON STKA, ALL OTHERS ON STKB 
IF (LVLS2(TEST) .EQ.LVLS2(IPRO)) GO TO 7¢ 
XB = XB + 1 
STKB(XB) = TEST 
GO TO 8¢ 
76 XA = XA41 
STKA(XA) = TEST 
8@ CONTINUE 
SORT STKA AND STKB INTO INCREASING DEGREE AND ADD STKA TO STKC 
AND STKB TO STKD 
IF (XA.EQ.@) GO TO 16¢ 
IF (XA.EQ.1) GO TO 9@ 
CALL SORTDG(STKC, STKA, XC, XA, NDEG) 
GO TO 10¢ 
96 XC = XC + 1 
STKC(XC) = STKA(XA) 
100 IF (XB.EQ.@) GO TO 12¢ 
IF (XB.EQ.1) GO TO 11 
CALL SORTDG(STKD, STKB, XD, XB, NDEG) 
GO TO 12¢ 
116 XD = XD + 1 
STKD(XD) = STKB(XB) 
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C BE SURE TO PROCESS ALL NODES IN STKC ; » NUM 99 
12@ CX = CX +1 : . vee NUM 1400 

. IF (XC.GE.CX) GO TO 5¢ ‘NUM 1610 
C WHEN STKC IS EXHAUSTED LOOK FOR MIN DEGREE NODE IN SAME LEVEL ' NUM 1920 
C WHICH HAS NOT BEEN PROCESSED . NUM 163¢ 
MAX = IDEG + 1 : - NUM 1646 

SND =N +1 NUM 1650 

DO 13¢ I=LST,LND NUM 166¢ 

TEST = LVLST(I) NUM 1670 

IF (RENUM(TEST) .NE.@) GO TO 13¢ . NUM 1980 

IF (NDEG(TEST) .GE.MAX) GO TO 13@ ~ NUM 199¢ 
RENUM(SND) = @ NUM 1160 
‘RENUM(TEST) = -1 ' NUM 1110 

: MAX = NDEG(TEST) ‘NUM 112¢ 

SND = TEST ° + NUM 1130 

13@ CONTINUE NUM 114¢ 
IF (SND.EQ.N+1) GO TO 14¢ NUM 115¢ 

XC = XC + 1 _ NUM 116@ 
STKC(XC) = SND NUM 117¢ 

GO TO 5¢ NUM 118¢ 

C IF STKD IS EMPTY WE ARE DONE, OTHERWISE COPY STKD ONTO STKC NUM 119¢ 
C AND TEGIN PROCESSING NEW STKC NUM 1206¢ 
149 IF (XD.EQ.@) GO TO 16¢ . NUM 121 
DO 15@ I=1,XD NUM 122¢ 
STKC(IL) = STKD(I) NUM 123¢ 

15@ CONTINUE NUM 124¢ 
XC = XD NUM 125¢ 

GO TO 4¢ ~ NUM 1260 

C DO FINAL BANDWIDTH AND PROFILE CALCULATIONS NUM 1276 
16¢ DO 17 I=1,N NUM 128¢ 
IF (IPFA(I).GT.IBW2) IBW2 = IPFA(I) NUM 1290 

IPF2 = IPF2 + IPFA(I) NUM 1300 

176 CONTINUE . . NUM 1310 
RETURN NUM 1320 


END - “NUM 133¢ 
ACM Transactions on Mathematical Software, Vol. 8, No. 2, June 1982, Page 221. 


REMARK ON ALGORITHMS 508 AND 509 


Matrix Bandwidth and Profile Reduction [H.L. Crane, Jr., N.E. Gibbs, W.G. 
Poole, Jr., and P.K. Stockmeyer, ACM Trans. Math. Softw. 2, 4 (Dec. 1976), 375- 
377] and A Hybrid Profile Reduction Algorithm [N.E. Gibbs, ACM Trans. Math. 
Softw. 2, 4 (Dec. 1976), 378-387] 


John G: Lewis [Received 28 May 1980; revised 6 January 1982; pares 10 
January 1982] 


Boeing Computer Services Co., Mail Stop 9C-01, 565 Andover Park West, 
Tukwila, WA 98188. 


A new implementation of the Gibbs—-Poole-Stockmeyer and Gibbs—King algo- 
rithms is available as Algorithm 582. This new implementation is faster, more 
robust, and requires less storage than the previous implementation of the Gibbs- 
Poole-Stockmeyer algorithm [1], distributed as Algorithm 508, and of the Gibbs- 
King algorithm [2], distributed as Algorithm 509. The mathematical capabilities 
of Algorithm 582 are identical to those of Algorithms 508 and 509. References [3] 
and [4] give the implementation details and documentation for the new imple- 
mentation. 
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ALGORITHM 509 
A Hybrid Profile Reduction Algorithm [ Fl] 


NORMAN E. GIBBS 
College of William and Mary 


Key Words and Phrases: bandwidth reduction, graph, King algorithm, leveling, profile 
reduction, sparse matrix 

CR Categories: 5.14, 5.32 

Language: Fortran 


DESCRIPTION 


1. Introduction 


Large sparse matrix problems arise in many applications areas, such as structural 
engineering, fluid dynamics, and network analysis. Many algorithms for auto- 
matically reordering the rows and columns of the matrix in order to reduce band- 
width and/or profile have been published. Recently, Gibbs et al. [4] concluded 
that of the many reduction algorithms available, theirs (as described in [3] and 
implemented as a Fortran program in [1]) and King’s (as described in [5] and 
implemented as a Fortran program as described in [4]) were superior for profile 
reduction. Although the King algorithm produced the best profile in many cases, 
it sometimes exhibited erratic behavior due to the strategy of reducing the profile 
globally by reducing the profile well locally. Furthermore, they found a large class 
of problems (wide cylinders—Type E3 in [4]) for which there is no good single 
starting point for the King algorithm. 

In this paper a new “hybrid” algorithm for reducing profile is presented. This 
algorithm combines the better features of [3] and [5] by first finding a pseudodi- 
ameter to produce a leveling and then numbering the leveling level by level accord- 
ing to King’s criteria. 

Section 2 describes the new profile reduction algorithm. In Section 3 it is com- 
pared in production mode with the better algorithms reported on in [4]. A listing 
of the Fortran subprogram used to implement the new algorithm is given in Ap- 
pendix A. The changes which must be made to the Fortran subroutine REDUCE 
[1] to implement the algorithm are given in Appendix B. 


2. Description of the Algorithm 


Let Av = b be an nXn sparse nonsingular system of linear algebraic equations. 
To define the profile of A, first define f; = min {j:a:; ~ 0} for = 1, 2,...,n 
(it is assumed that a;; ~ 0). This locates the leftmost nonzero element in each row. 
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Now set 5; = 7 — f;. The profile is defined to be >07-1 6; . Given such a matrix A, 
we define a graph G = (V, E) where V has n vertices, {v1 , 02, ...,Un} and {v;,v,} € # 
if a;; ~ O andi + j. It is well known (sec, for example [8]) that the problem of 
matrix profile reduction can be restated as a problem of graph profile reduction. 
The algorithm presented here is described in terms of graphs and is directly appli- 
cable to graphs. 

We assume that the reader is familiar with Algorithms I and II of Gibbs et al. 
[3] and with King’s algorithm [5]. The reader is referred to [3] for the definitions 
and notation used below. 

Algorithms I and II accept as input a connected graph and produce as output a 
leveling. A leveling of a graph G = (V, E) is a partition of the vertices V into levels 
Iy, L2g,..., Lx such that 

(1) all vertices adjacent to vertices in level Z; are either in level Z; or level Lz; 

(2) all vertices adjacent to vertices in level L;, are either in level Ly: or level Ly; 

(3) for1 <7 < k, all vertices adjacent to vertices in level Z; are in either level 
Lin ) level L; » or level Liga . 

The new algorithm, Algorithm P, described below is applied to the leveling of a 

connected component of a graph. The following assumptions are made, 

(1) Li, L[2,..., Lx is a leveling produced by algorithms I and II and the num- 
ber of levels, k, must be at least two. 

(2) On input the variable nextnum is initialized to the next available integer to 
be assigned to this connected component. On output nextnum will be set to 
the next available integer to be assigned to the next connected component. 

(3) The variables S2, S3, and Q represent queues of integers. If X is a queue 
of integers and « is an integer variable, then: 

(a) X << X — {x} means remove the integer x from the queue X (treating 
X as a set). 

(b) X <= x means place the integer x at the rear of the queue X. 

(c) x <= X means set the variable x to the integer at the front of the queue 
X after removing it from X. 

(d) X < § means empty the queue X. 

(e) | X | represents the current size of the queue X. 

(4) Algorithm P produces as output a vector new, where new(7) = j means that 
the old vertex labeled with the integer 7 should be relabeled with the integer j. 


ALGORITHM P. PROFILE REDUCTION 


PO. [Initialization.] Set S2<— L; andz<—1. 

Pl. {Form the next level and empty Q.] Set S3 <— Li, and Q <— 9. 

P2. [Find the next vertex to be numbered according to King’s criteria.] Set m equal to the 
first element of S2 which has fewest connections to S3. Set C equal to the set of elements 
of S3 which are joined by an edge to m. 

P38. [{Numbering.] Set new(m) — nextnum, S2 <— S2 — {m}, nexinum <— nextnum + 1, and 
for each element c € C set Q <= c and S83 — S3 — {c}. 

P4. [Is S2 empty?] If | S2| = 0 goto step P7. 

PS. [S2 is not empty. Is S3 empty?] If | 83 | > 0 return to step P2. 

P6. [S2 is not empty, but S3 is empty.] For j = 1,2,..., | S2| sets < 82, new(s) — nextnum, 
and nexinum < nextnum + 1. Goto step P8. 

P7. [S2 is empty. If 83 is not empty place the rest of 83 in Q.] If | 83 | > 0 then set q<= 88, 
Q = q, and repeat step P7. 

P8. [S2 and S83 are empty.] Set 77+ 1.I1f7% < k (the last level) then set S2 — Q and return 
to step Pl. 

P9. [All levels are numbered except the last level which is in Q.] If |Q | = 0 then terminate 
the algorithm; otherwise set ¢ <= Q, new(q) — nexinum, nextnum — nextnum + 1, and 
repeat step P9. 


Algorithm P assigns consecutive integers, level by level, to the leveling according 
to King’s criteria. In fact, this algorithm is the King algorithm restricted to assign- 
ing consecutive integers to the vertices in one level at a time. If initially S2 was 
a single vertex v, S3 was set to V — {v}, and the elements of C were placed directly 
into S2 instead of Q in step P3 we would, in essence, have King’s algorithm. 
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It turns out that reversing the numbering new by setting new(7) <— n — new(7) 
+ 1 forz = 1, 2,..., m sometimes improves profile. We have not been able to 
predict a priori when reversing helps, so every numbcring is reversed and the num- 
bering that gives smaller profile is chosen (see subroutine CHECK in Appendix A.) 


3. Test Results in Production Mode 


The new algorithm as described above and implemented as a Fortran subroutine 
named PROFIT (see Appendix A) was integrated into the Fortran package de- 
scribed in [1]. A parameter was added to subroutine REDUCE so that the user can 
specify whether profile reduction is more important than bandwidth reduction or if 
bandwidth reduction is more important than profile reduction. The changes which 
were made to REDUCE are described in Appendix B. 

As stated in [8], every practical bandwidth or profile reduction algorithm is 
heuristic in the sense that one cannot make absolute a priori statements concerning 
the performance of the algorithm; the performance is data dependent. In order to 
relate this work to previous work the new algorithm was tested on the samc test 
data described in [4]. Tables I and II summarize the results. These tables show 
how subroutine REDUCE with subroutine PROFIT performed relative to Gibbs 
et al. (GPS [1, 3]) and King (KNG [5, 4]), with respect to bandwidth reduction, 
profile reduction, and time. The times are relative to 1.00 for GPS. 


4. Conclusions 


Although the new algorithm takes more time than GPS, it is clear that it is superior 
to GPS in reducing profile. The new algorithm yields profile comparable to KNG, 
but takes less time and does not exhibit KNG’s erratic behavior. 

In retrospect, the good performance of GPS for bandwidth reduction and the 
new algorithm for profile reduction can be explained. The Cuthill-McKee [2] and 
King algorithms do a good job of reducing bandwidth and profile respectively by 
numbering well locally. Since these algorithms examine the graph’s structure 
locally, they sometimes behave erratically. The algorithms for producing a leveling 
by first finding a pseudodiameter and then using it to minimize level width take the 
entire structure of the graph into account and thus, when the Cuthill-McKee or 
King numbcring is imposed on a leveling one obtains comparable bandwidth or 
profile respectively. The GPS algorithm and the new algorithm give superior band- 
width or profile reduction on those cases where global strategy is necessary. 


WOOnaA URW NF 


n: order of matrix; 8: bandwith; p: profile; RATIO: ratio to GPS time 


Original 
8B p 
45 598 
85 1020 
80 2127 
126 3615 
19 1046 
16 1569 
168 7534 
166 8532 
262 2681 
30 2046 
302 23357 
262 18076 
216 16435 
344 29790 
173 7913 
399 35837 
480 56322 
833 100560 
840 124607 


Table I. Applications Problems 
See [3] for a description. 


GPS 


Profit 


10.79 


59.50 
37.66 
5.87 


KNG 


216 


1496 
1046 
1341 
2882 
1754 
2152 
1823 
2660 
6679 
6302 
8875 
7913 
4134 
23106 
54159 
54104 
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Table II. Selected Grid Problems 
See [4] for a complete description of grids. * indicates test not run. 
n: order of matrix; 8: bandwidth; p: profile; RATIO: ratio to GPS time 
Al: square grid (5-point difference scheme); B3: 3X1 rectangle (9-point difference scheme) 
: 201 cylinder (9-point difference scheme) ; E2: 1X20 cylinder (7-point difference scheme) 


(3009) SAHLIMODTV GALOATION 


D3 
Original GPS Profit KNG 

n B p B p 8B e Ratio B ) Ratio 
49 47 406 7 245 7 245 1.750 7 245 27.33 
100 98 1153 10 705 10 705 2y4 11 11 705 51.57 
400 398 8713 20 5510 20 5510 4.068 21 5510 156.28 
625 623 16768 25 10700 25 10700 5.253 25 10700 158.45 
48 46 366 5 212 5 212 1.267 7 211 4.68 
432 430 7078 13 5436 13 5436 2.389 23 5371 7.02 
1200 1198 29406 21 24740 yal 24740 3.987 39 24503 7.86 
1728 1726 49306 23 42552 25 42552 4.801 47 42209 8.27 
500 498 71474 7 3175 7 3175 13379 9 3172 9.64 
980 978 218512 9 8351 9 8351 Ls579 13 8341 13.19 
1620 1618 490830 11 17199 11 17199 ber 67 17 17178 18.65 
2420 2418 926828 i3 30679 13 30679 2.005 21 30643 22.96 
320 318 3367 10 2662 9 2512 2.071 13 2507 93.76 
720 718 10541 14 8942 14 8486 3.040 23 8468 117.30 

1280 1278 23931 18 21038 19 20120 4.197 * * 

2000 1998 45457 22 40838 24 39302 5.174 * * 
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APPENDIX A 
SUBROUTINE PROFIT(NR, NDSTK, NEW, NDEG, LVLS2, LVLST, LSTPT, 
* NXTNUM) 
SUBROUTINE PROFIT NUMBERS LEVEL BY LEVEL WITH CONSECUTIVE INTEGERS 
USING A MODIFIED VERSION OF KING*S ALGORITHM. : 
NR- ROW DIMENSION OF CONNECTION TABLE. 
NDSTK- THE CONNECTION TABLE. 
NEW- VECTOR TO STORE THE NEW NUMBERING. 
NDEG(I)- THE DEGREE OF NODE I. 
LVLS2- THE LEVEL STRUCTURE PRODUCED BY PIKLVL. 


aAaaAan MQAAMQANMNANQNQAAANAANRAAANAAA 


ana 


aAaaand 


aa 


LVLS2(1I) = J MEANS VERTEX I HAS BEEN 
PLACED IN LEVEL J. 
LVLST- ON OUTPUT, CONTAINS THE LEVEL STRUCTURE USED. 
LVLST(LSTPT(I)),...,LVLST(LSTPT(I+1)-1) ARE 
THE VERTICES IN LEVEL I. 
LSTPT(1)- ON OUTPUT, INDEX INTO LVLST TO FIRST NODE IN LEVEL I. 
LSTPT(I+1) - LSTPT(I) = NUMBER OF NODES IN I*TH LEVEL. 
NXTNUM- ON INPUT AND OUTPUT, THE NEXT AVAILABLE NUMBER. 
ON IBM 36@ OR 37@ USE INTEGER * 2 NDSTK. 
INTEGER NDSTK 
INTEGER NEW(1), NDEG(1), LVLS2(1), LVLST(1), LSTPT(1) 
DIMENSION NDSTK(NR, 1) 


COMMON AREA GRA HOLDS VITAL INFORMATION ABOUT THE GRAPH 

N- THE NUMBER OF NODES 

IDPTH- THE NUMBER OF LEVELS FOUND BY PIKLVL. 

IDEG- MAXIMUM DEGREE OF GRAPH -- COLUMN DIMENSION OF NDSTK. 


COMMON /GRA/ N, IDPTH, IDEG 
IT IS ASSUMED THAT NO LEVEL HAS MORE THAN 1¢@ NODES. 
COMMON /LVLW/ S2(140), S3(140), Q(106) 
COMMON /CC/ CONECT (100) 
INTEGER S2, S3, Q, CONECT, S2SZE, S3SZE, QPTR, CONSZE 
SET UP LVLST AND LSTPT FROM LVLS2. 
NSTPT = 1 
DO 2@ I=1, IDPTH 
LSTPT(L) = NSTPT 
DO 1@ J=1,N 
IF (LVLS2(J).NE.I) GO TO 1¢ 
LVLST(NSTPT) = J 
NSTPT = NSTPT + 1 
10 CONTINUE 
2@ CONTINUE 
LSTPT(IDPTH+1) = NSTPT 


PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 


RREKKKEKKRKKKKEKKKK STEP PG REKREKKKEREKRKRERERERERERRRREREREREREREREREPRO 


$2 IS THE FIRST LEVEL. 
LEVEL = 1 
CALL FORMLV(S2, S2SZE, LSTPT, LVLST, LEVEL) 


PRO 
PRO 
PRO 


KEKKEKKERERKKKEAKERK STEP DP] RXAKAAKKAAAKARARKAAKARARAARRKKAARAKRAREEPRO 


$3 IS THE LEVEL ADJACENT TO THE LEVEL S2. 
Q IS A QUEUE USED TO RETAIN THE ORDER IN WHICH THE ELEMENTS OF S3 
ARE REMOVED. Q EVENTUALLY BECOMES THE NEW S2 AND IS ORDERED 
ACCORDING TO KING*S CRITERA. 
3@ CALL FORMLV(S3, S3SZE, LSTPT, LVLST, LEVEL+1) 

QPTR = @ 


PRO 
PRO 
PRO 
PRO 
PRO 
PRO 


REKKKREREKKKRREKKER STEP P2 RRERERRERKERARERREREERRRERERRERERERREREERPRO 


FIND THE NODE M IN S2 WHICH IS ADJACENT TO THE FEWEST NODES IN S3. 
40 M = MINCON(S2,S2SZE,S3,S3SZE,CONECT ,CONSZE,NDSTK,NR,NDEG) 


PRO 
PRO 


RERKKERKEKKRERKKEE STEP P3 RERRERRERRERERREKRERRRRERERERERRKRRKRERKEKPRO 


NUMBER M AND REMOVE IT FROM S82. 
NEW(M) = NXTNUM 
NXTNUM = NXTNUM + 1 


PRO 
PRO 
PRO 
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aAAgAANAN 


CALL DELETE(S2, S2SZE, M) 
IF (CONSZE.LE.@) GO TO 6@ 
THE ELEMENTS OF CONLST ARE TO BE REMOVED FROM $3 AND PLACED INTO 


DO 5@ I=1,CONSZE 
QPTR = QPTR + 1 
Q(QPTR) = CONECT(I) 
CALL DELETE(S3, S3SZE, CONECT(I)) 
5@ CONTINUE 


PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 


REKRRKEKKEKKERKEEK = STEP PG RRARKRERREEKEREREKRERERERERERERERERREREREKPRO 


6@ IF (S2SZE.LE.6) GO TO 8¢ 


PRO 


RERKRRKKERERREREKE. STEP PS RERKRKEKRKEKRKAEKRKKEEREERRERERERERERRRRRRRRERDPRO 


IF (S3SZE.GT.@) GO TO 4¢ 


PRO 


HERKKERAKRAKRKKKKKK STEP PG — KARKAKAAKKAAKAAKARAKAAKAKKAKKAAKRARERE EAR PRO 


$3 IS EMPTY, BUT S2 IS NOT. RENUMBER THE NODES WHICH REMAIN IN S82. 
DO 7@ I=1,S2SZE 
NS2 = S2(I) 
NEW(NS2) = NXTNUM 
NXTNUM = NXTNUM + 1 
7@ CONTINUE 
GO TO 10¢ 


PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 


RERKRERKERKEKEREKEK STEP P7 RRERKEKKRKRERERERERERERERERRRERERERERRREKE PRO 


8@ IF (S3SZE.LE.@) GO TO 106¢ 
$2 IS EMPTY, BUT S3 IS NOT. MOVE $3*S REMAINING NODES INTO Q. 
DO 9¢ I=1,S3SZE 
QPTR = QPTR + 1 
Q(QPTR) = $3(T) 
96 CONTINUE 


PRO 
PRO 
PRO 
PRO 
PRO 
PRO 


KEKKAKKKAKKRKAKKKK STEP PQ —- RAKKAKKAKAKARAAKARKARKAKAAAAKARKKKARKKEREPRO 


196 LEVEL = LEVEL + 1 
IF (LEVEL.GE.IDPTH) GO TO 12@ 
$2 BECOMES THE OLD Q SINCE BOTH S2 AND S3 ARE EMPTY. 
DO 11¢ I=1,QPTR 
$2(I) = Q(T) 
11¢ CONTINUE 
S2SZE = QPTR 
GO TO 3¢ 


PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 


HAKKKKKKERAARERKKEKK STEP PQ — RXKAKKAKAAKAKARAKAKAKARKAAKARKAKKKAKERAEPRO 


LAST LEVEL IS ORDERED IN Q, SO NUMBER IT BEFORE RETURNING. 
12@ DO 130 I=1,QPTR 
IQ = Q(I) 
NEW(IQ) = NXTNUM 
NXTNUM = NXTNUM + 1 
130 CONTINUE 
RETURN 
END 


FUNCTION MINCON(X, XSZE, Y, YSZE, CONLST, CONSZE, NDSTK, NR, 
* NDEG) 
FUNCTION MINCON RETURNS AS ITS FUNCTIONAL VALUE A VERTEX X(I) SUCH 
THAT THE NUMBER OF CONNECTIONS FROM X(I) TO THE SET Y IS A MINIMUM. 
THE VERTICES OF Y WHICH ARE ADJACENT TO X(I) ARE PLACED IN 
CONLST(1), CONLST(2),...,CONLST(CONSZE). 
USE INTEGER * 2 NDSTK ON IBM 36@ OR 370. 
INTEGER NDSTK 
DIMENSION NDSTK(NR, 1) 
INTEGER X(1), XSZE, Y¥(1), YSZE, CONLST(1), CONSZE, NDEG(1) 
IT IS ASSUMED THAT NO LEVEL HAS MORE THAN 1@@ VERTICES. 
INTEGER SMLST(10@) 
CONSZE = YSZE + 1 
DO 5@ I=1,XSZE 
LSTSZE = @ 
IX = X(I) 
IROWDG = NDEG(IX) 
DO 20 J=1,YSZE 
DO 1@ K=1, IROWDG 
IX = X(I) 
IF (NDSTK(IX,K) .NE.Y(J)) GO TO 10 
SMLST(LSTSZE+1) = Y(J) 
LSTSZE = LSTSZE + 1 
IF (LSTSZE.GE.CONSZE) GO TO 5@ 
GO TO 20 
10 CONTINUE 
2@ CONTINUE 
IF (LSTSZE.GT.6) GO TO 3¢@ 


PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 
PRO 


MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
MIN 
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C WE HAVE FOUND A VERTEX IN X WHICH IS NOT CONNECTED TO ANY VERTEX MIN 29¢ 
c INY MIN 30¢ 
MINCON = X(I) MIN 31¢ 
CONSZE = @ MIN 32¢ 
RETURN MIN 330 


C WE HAVE FOUND A VERTEX X(I) WITH FEWEST CONNECTIONS (NONZERO) TO Y MIN 34¢ 
C SO FAR. SAVE THE ELEMENTS OF Y WHICH CONNECT TO X(I) IN CONLST AND MIN 35¢ 


C SAVE X(I) AS THE FUNCTIONAL VALUE. MIN 36¢@ 
30 CONSZE = LSTSZE MIN 37@ 
DO 4@ J=1,LSTSZE MIN 38¢@ 
CONLST(J) = SMLST(J) MIN 39¢ 

4@ CONTINUE MIN 460 
MINCON = X(I) MIN 41¢ 

5@ CONTINUE MIN 4206 
RETURN MIN 43¢ 

END MIN 446 
SUBROUTINE DELETE(SET, SETSZE, ELEMNT) DEL 1¢ 

C SUBROUTINE DELETE REMOVES ELEMNT FROM THE SET SET IF ELEMNT DEL 2¢ 
C IS IN SET. OTHERWISE, IT ISSUES A DIAGNOSTIC. DEL 3@ 
INTEGER SET(1), SETSZE, ELEMNT DEL 4@ 

IF (SETSZE.GT.1) GO TO 1¢@ DEL 5¢@ 

IF (SETSZE.EQ.1 .AND. SET(1).NE.ELEMNT) GO TO 3¢ DEL 69 
SETSZE = @ DEL 76 
RETURN DEL 8@ 

16 DO 20 I=1,SETSZE DEL 9 

IF (SET(L).EQ.ELEMNT) GO TO 4@ DEL 10¢ 

2@ CONTINUE DEL 11¢@ 

30 WRITE (6,99999) ELEMNT, (SET(1),I=1,SETSZE) DEL 120 
RETURN DEL 13@ 

4@ SETSZE = SETSZE - 1 DEL 14@ 
DO 5@ J=1,SETSZE DEL 15¢ 
SET(J) = SET(J+1) DEL 16¢ 

5@ CONTINUE DEL 17¢ 
RETURN DEL 18¢@ 

99999 FORMAT (1@H@ERROR -- , 16, 8H NOT IN , (2@15)) DEL 19¢ 
END DEL 2¢¢ 
SUBROUTINE FORMLV(SET, SETSZE, LSTPT, LVLST, LEVEL) FOR 10 

C FORMLVL COPIES LEVEL(LEVEL) INTO SET. FOR 20 
INTEGER SET(1), SETSZE, LSTPT(1), LVLST(1), UPPER FOR 30 
LOWER = LSTPT (LEVEL) FOR 40 
UPPER = LSTPT(LEVEL+1) - 1 FOR 50 
SETSZE = 1 FOR 6@ 

DO 1@ I=LOWER ,UPPER FOR 7@ 
SET(SETSZE) = LVLST(L) FOR 80 

SETSZE = SETSZE + 1 FOR 9¢@ 

1@ CONTINUE FOR 100 
SETSZE = SETSZE - 1 FOR 116 
RETURN FOR 12¢ 

END FOR 13¢ 
SUBROUTINE CHECK(BESTBW, BESTPF, RENUM, NDSTK, NR, NDEG, IWK) CHE 1¢@ 

C SUBROUTINE CHECK TESTS TO SEE IF REVERSED NUMBERING GIVES BETTER CHE 206 
C PROFILE THAN PROFIT. IF IT DOES, THEN RENUM IS REVERSED AND BESTPF CHE 30 
C IS SET TO THE SMALLEST OF RENUM AND REVERSED RENUM. CHE 4@ 
C USE INTEGER * 2 NDSTK ON IBM 360 OR 37 CHE 5@ 
INTEGER NDSTK CHE 6¢@ 
DIMENSION NDSTK(NR, 1) CHE 7¢ 
INTEGER BESTBW, BESTPF, RENUM(1), NDEG(1), IWK(1) CHE 8@ 
COMMON /GRA/ N, IDPTH, IDEG CHE 96 

DO 1@ I=1,N CHE 10 
IWK(I) = N - RENUM(I) + 1 CHE 110 

1@ CONTINUE CHE 126 
CALL BAND(BESTBW, BESTPF, RENUM, NDSTK, NR, NDEG) CHE 130 

CALL BAND(IBW, IPF, IWK, NDSTK, NR, NDEG) CHE 14 

IF (IPF.GE.BESTPF) RETURN CHE 150 

DO 2¢ I=1,N CHE 160 
RENUM(L) = IWK(I) CHE 1790 

2@ CONTINUE CHE 180 
BESTPF = IPF CHE 19¢ 
RETURN CHE 200 


END CHE 219 


COLLECTED ALGORITHMS (cont.) 


. SUBROUTINE BAND(IBW, IPF, NEW, NDSTK, NR, NDEG) .. 
C. SUBROUTINE BAND COMPUTES THE BANDWIDTH IBW AND THE PROFILE 
C IPF OF THE GRAPH REPRESENTED BY NDSTK USING THE NUMBERING NEW. 
Cc ON ‘TBM ‘360 OR 37@ USE INTEGER * 2.NDSTK.: 
INTEGER NDSTK 
DIMENSION NDSTK(NR,1), NEW(1), NDEG(1) 
COMMON /GRA/ N, IDPTH, IDEG 
IPF = @ 
- [BW = @ 
- DO 26 K#1,N 
TEND = NDEG(K) a i 
"IF (IEND.EQ.@) GO TO 2¢ 
NBW = @ 
DO 10 J=l,IEND 
’  IDUMMY = NDSTK(K,J) 
NTEST = NEW(K) -— NEW(IDUMMY) 
IF (NTEST.LE.NBW) GO TO 1¢ 
NBW = NTEST 
16 | CONTINUE 
IPF = IPF + NBW 
IF (NBW.GT.IBW) IBW = NBW 
2¢@ CONTINUE 
RETURN 
END 


th 


APPENDIX B. SUMMARY OF CHANGES TO FORTRAN SUBROUTINE REDUCE NECESSARY 


TO IMPLEMENT ALGORITHM P 


There are seven changes which have to be made to REDUCE to use the subpro- 
grams given in Appendix A. The first is to add the variable OPTPRO to REDUCE’s 
argument list. One change, the sixth, requires adding a statement number. The 
remaining five changes require inserting statements in the proper place in REDUCE. 
The update cards are underlined and at least one line of REDUCE before and after 


each alteration is given. 


SUBROUTINE REDUCE(NDSTK, NR, IOLD, RENUM, NDEG, LVL, LVLS1, 
* LVLS2, CCSTOR, IBW2, IPF2, OPTPRO) 
C SUBROUTINE REDUCE DETERMINES A ROW AND COLUMN PERMUTATION WHICH, 


IDEG- MAXIMUM DEGREE OF ANY NODE IN THE GRAPH. 
OPTPRO- SET TO 1 BY CALLING PROGRAM IF PROFILE REDUCTION 
IS MORE IMPORTANT THAN BANDWIDTH REDUCTION. 
SET TO ANY OTHER INTEGER IF BANDWIDTH REDUCTION IS 
MORE IMPORTANT THAN PROFILE REDUCTION. 
EXPLANATION OF OUTPUT VARIABLES-— 


QIQIQIAIQ a 


INTEGER STNODE, RVNODE, RENUM, XC, SORT2, STNUM, CCSTOR, 
* SIZE, STPT, SBNUM 
INTEGER OPTPRO 


COMMON /GRA/ N, IDPTH, IDEG 


.7 


CALL FNDIAM(STNODE, RVNODE, NDSTK, NR, NDEG, LVL, LVLS1, 
* LVLS2, CCSTOR, IDFLT) 

IF (OPTPRO.EQ.1) GO TO 50 

IF (NDEG(STNODE).LE.NDEG(RVNODE)) GO TO 50 


70 ISDIR = ISDIR*NFLG 
NUM = SBNUM 


C IF PROFILE REDUCTION IS MORE IMPORTANT CALL PROFIT INSTEAD OF 


C NUMBER AND IGNORE ISDIR. 
IF (OPTPRO.EQ.1) GO TO 90 
IF (ISDIR.LT.0,) NUM = STNUM 


C IF ORIGINAL NUMBERING IS BETTER THAN. NEW ONE, SET UP TO RETURN IT 
75 DO 80 I=1,N 
RENUM(I) = IOLD(T) 


RETURN 


RED 


RED 


RED 


RED 
RED 
RED 
RED 
RED 
RED 


RED 
RED 
RED 
RED 


RED 
RED 
RED 
RED 


RED 
RED 
RED 
RED 
RED 
RED 


RED 
RED 
RED 


RED 


230 
240 


10 
20 
30 


330 
331 
332 


334 
340 


560 
570 
571 
580 


960 
970 
971 
980 


1220 
1230 
1231 
1232 
1233 
1240 


1320 
1330 
1340 


1380 
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90 CALL PROFIT(NR, NDSTK, RENUM, NDEG, LVLS2, LVLS1, LVL, NUM) ___RED 1381 
SBNUM = NUM RED 1382 

IF (SBNUM.LE.STNUM) GO TO 30 RED 1383 

C SOMETIMES PROFILE REDUCTION IS IMPROVED BY REVERSING THE NUMBERING RED 1384 
© PRODUCED BY PROFIT. SUBROUTINE CHECK DETERMINES IF THIS IS THE CASE. RED 1385 
; CALL CHECK(IBW2, IPF2, RENUM, NDSTK, NR, NDEG, LVL) RED 1366 
]IF ORIGINAL NUMBERING GIVES BETTER PROFILE USE IT RATHER THAN RENUM. RED 1387 
IF (IPF2.LE.IPF1) RETURN ene RED 1388 

60 _T0 75 =. OO ee RED 1389 
END" RED 1390 
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A new implementation of the Gibbs—Poole-Stockmeyer and Gibbs-King algo- 
rithms is available as Algorithm 582. This new implementation is faster, more 
robust, and requires less storage than the previous implementation of the Gibbs- 
Poole-Stockmeyer algorithm [1], distributed as Algorithm 508, and of the Gibbs- 
King algorithm [2], distributed as Algorithm 509. The mathematical capabilities 
of Algorithm 582 are identical to those of Algorithms 508 and 509. References [3] 
and [4] give the implementation details and documentation for the new imple- 
mentation. 
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Algorithm 510 
Piecewise Linear Approximations to 
Tabulated Data [E2| 


D. G. WILSON 
Oak Ridge National Laboratory 


Key Words and Phrases: approximation, first degree spline, linear, piecewise linear 
CR Categories: 5.13 
Language: Fortran 


DESCRIPTION 


This algorithm generates a piecewise linear approximation to tabulated data which 
is within specified tolerances of the data points. There are eight options available. 
The approximation may be required to be continuous or not, a single tolerance or 
a tolerance for each data point may be specified, and the approximation may or 
may not be restricted to the piecewise linear ‘‘tolerance band” centered at the data 
points with edges determined by the tolerances at the data points. Among approxi- 
mations of the kind requested, the algorithm gives one of fewest line segments. 

The algorithm processes data in order of increasing abscissa values, successively 
finding the longest approximating segment by a systematic search technique. This 
algorithm is a descendent of the onc given in [1] and the systematic search tech- 
nique is the same. The specified options determine where a new segment begins 
and whether or not successive segments intersect. 

Even if a continuous approximation is not requested, the algorithm determines 
whether or not successive segments would intersect at an acceptable point if the 
partition point between them were adjusted. If this is the case, the adjustment is 
made. This means that the algorithm may give a continuous approximation when 
one was not requested even in cases where the algorithm of [1] would not. However 
it does not mean that the algorithm will necessarily give a continuous approxima- 
tion when one is not requested even though there may exist a continuous approxi- 
mation of the same number of line segments. 

In many cases there is considerable freedom of choice in determining the last 
segment or two of the approximation. The criteria used to make these choices are 
continuity first and nearness of approach to the data second. 

The algorithm will accept any nonnegative tolerances. If all tolerances are zero, 
then the approximation linearly interpolates the data. 

When the approximation is required to be continuous and not restricted to the 
tolerance band, the algorithm gives a first degree spline which approximates the 
data within the specified tolerances and is of fewest line segments. 
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The inputs and outputs including the form of the approximation generated are 
described after the calling sequence, which is: 


CALL STL2(X,Y,E,M,U,V,W,K,IP) 


X, Y, KE, and M contain input data; U, V, K, and possibly W contain output; 
and IP contains a parameter which specifies the options desired. 

X and Y are real arrays of M elements. X(I) and Y(I) contain the abscissa and 
ordinate respectively of the I-th data point. M is an integer variable containing the 
dimension of the arrays X and Y. 

EK may be a single real variable or an M-element array depending on the value of 
IP. E contains the nonnegative tolerance or tolerances. If E is an array, then E(1) 
is the tolerance associated with (X(I), Y(I)) forI = 1,..., M. 

U and VY are real arrays of at least K + 1 elements. (Since K, the number of ap- 
proximating segments, is not known a priori, the dimension of U and V must be 
“sufficiently large.’’?) After STL2 has executed, U will contain a partition of the 
interval [X(1),X(N)] with U(1) = X(1) and U(K + 1) = X(N). V(I) is an 
ordinate to be associated with U(1) in the approximation. If a continuous approxi- 
mation is requested, then V(I) is ‘“‘the’’ ordinate to be associated with U(I). 

If a continuous approximation is requested, then W is not used. In this case the 
I-th approximating segment is the straight line from (U(I),V(I)) to (U(I + 1), 
V(I + 1)). 

If a continuous approximation is not requested, then W is a real array of at 
least K elements. In this case the I-th approximating segment is the straight line 
from (U(I),W(I)) to (U(I + 1),V(I + 1)), and V(1) is set equal to W(1). 

K is an integer variable. After STL2 has executed, K will contain cither the 
number of approximating line segments or zero. K will be set to zero in case of an 
error return. 

Call STL2(X,Y,E,M,X,Y,E,M,IP) will not cause problems provided that either 
a continuous approximation is requested, or E is a sufficiently large real array. 

IP is an integer variable. The content of IP is the product of three indicators: 
I1, 12, and I8. I1 indicates whether or not E is an array of tolerances. I1 = —1 
indicates that E is an array. I1 = +1 indicates that E is a single variable. I2 indi- 
cates whether or not the approximation is to be restricted to the tolerance band 
about the data. 12 = 1 indicates that the approximation is not to be restricted to 
the tolerance band. 12 = 2 indicates that the restriction 7s to be so restricted. I3 
indicates whether or not the approximation is required to be continuous. I3 = 1 
indicates that the approximation need not be continuous. I3 = 3 indicates that the 
approximation must be continuous. 

The program performs the following data checks: Are the abscissa values stored 
in order of increasing magnitude? Is the tolerance (or are the tolerances) nonnega- 
tive? Is the number of data points greater than 1? If the answer to any of these 
questions is no, then the program returns with K set to zero. In unis case no further 
processing is srtompted: 


TEST RESULTS 


This algorithm has successfully approximated 10 sets of data specifically designed 
to test various parts of the program. The main routine was written to repeat each 
data set with the ordinate values replaced by their negatives. This provides a new 
approximation problem for the algorithm, essentially doubling the number of data 
sets, but one for which the result is known. In addition, each data set was run with 
each possible option. Thus roughly 150 approximations have been gencrated for 
data sets of typically 12 points. 

These tests were performed on IBM 360 model 75 and model 91 computers. Exe- 
cution time is highly dependent on the data; however the model 91 processed 80 
approximation problems of 10 to 12 points cach in 2.04 seconds. Since the processing 
associated with terminating and initiating segments is nonnegligible and since in 
these constructed test cases the ratio of approximating segments to data points was 
almost .5, one would expect the program to do slightly better for smoother data. 
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ALGORITHM 
SUBROUTINE STL2(X, Y, E, M, U, V, W, K, IP) STL 10 
C PIECEWISE LINEAR APPROXIMATIONS OF FEWEST STL 2 
C LINE SEGMENTS WITHIN GIVEN TOLERANCES. STL 3¢@ 
C X,Y,E AND M CONTAIN INPUT DATA. STL 4@ 
C U,V,K AND POSSIBLY W CONTAIN OUTPUT. STL 50 
C IP IS A PARAMETER DETERMINING THE OPERATION STL 60 
C OF THE PROGRAM. STL 76 
C X AND Y ARE INPUT DATA ARRAYS OF M ELEMENTS STL 8@ 
C X(I),Y(I) CONTAINS THE ITH DATA POINT. STL 9¢@ 
C E MAY BE A SINGLE TOLERANCE OR A TABLE OF STL 19@ 
C TOLERANCES DEPENDING ON THE VALUE OF IP. STL 11¢ 
C IF E IS AN ARRAY, THEN E(I) IS THE TOLERANCE STL 12¢ 
C ASSOCIATED WITH X(I),Y(I) AND E MUST CONTAIN STL 136 
C M NONNEGATIVE ELEMENTS. STL 14¢ 
C U AND V ARE OUTPUT ARRAYS OF K+l ELEMENTS. STL 15¢ 
C U IS A PARTITION OF THE INTERVAL (X(1),X(N)) STL 1606 
C WITH U(1)=X(1) AND U(K+1)=X(N). STL 17¢ 
C V(I) IS AN ORDINATE TO BE ASSOCIATED WITH STL 18¢ 
C U(I) IN THE APPROXIMATION. (IF A CONTINUOUS STL 190 
C APPROXIMATION IS REQUESTED, THEN V(I) IS STL 200 
C '‘'THE' ORDINATE TO BE ASSOCIATED WITH U(I).) STL 21¢ 
C IF A CONTINUOUS APPROXIMATION IS REQUESTED, STL 22¢ 
C THEN W IS NOT USED. IN THIS CASE THE ITH STL 23 
C APPROXIMATING SEGMENT IS THE STRAIGHT LINE STL 240 
C FROM U(I),V(I) TO U(I+1) ,V(I+1). STL 250 
C IF A CONTINUOUS APPROXIMATION IS NOT STL 260 
C REQUESTED, THEN W IS A K-ELEMENT OUTPUT STL 27¢ 
C ARRAY. IN THIS CASE THE ITH APPROXIMATING STL 280 
C SEGMENT IS THE STRAIGHT LINE FROM STL 290 
C U(I),W(I) TO U(I+1),V(I+1), AND V(1) IS STL 36¢ 
C SET EQUAL TO W(1). STL 3106 
C K IS THE NUMBER OF SEGMENTS IN THE PIECE- STL 32@ 
C WISE LINEAR APPROXIMATION GENERATED. IN STL 33¢ 
C CASE OF AN ERROR RETURN, K WILL BE SET TO STL 34¢ 
C ZERO. STL 350 
C THE CONTROL PARAMETER IP IS THE PRODUCT STL 36¢ 
C OF THREE INDICATORS 11,12 AND I3. STL 37¢ 
C I1 INDICATES WHETHER OR NOT E IS AN STL 380 
Cc ARRAY OF TOLERANCES. STL 39¢ 
Cc Il = -1 INDICATES E IS AN ARRAY STL 46¢ 
Cc Il = +1 INDICATES E IS A SINGLE NUMBER. STL 41¢ 
C 12 INDICATES WHETHER OR NOT THE STL 42¢ 
Cc APPROXIMATION IS TO BE RESTRICTED TO STL 43¢ 
eC THE 'TOLERANCE BAND' ABOUT THE DATA. STL 44¢ 
C I2 = 1 INDICATES NO BAND RESTRICTION STL 45@ 
Cc I2 = 2 INDICATES APPLY THIS RESTRICTION STL 46¢ 
C (THE 'TOLERANCE BAND' IS A PIECEWISE SIL 47 
Cc LINEAR BAND CENTERED AT THE DATA WHOSE STL 48¢ 
C WIDTH IS DETERMINED BY THE TOLERANCES STL 49¢ 
Cc AT THE DATA POINTS.) STL 56¢ 
C 13 INDICATES WHETHER OR NOT THE STL 51@ 
Cc APPROXIMATION MUST BE CONTINUOUS. STL 52¢ 
Cc I3 = 1 INDICATES CONTINUITY NOT REQUIRED STL 53¢ 
Cc 13 = 3 INDICATES CONTINUITY IS REQUIRED STL 540 
C CALL STL2 (X,Y,E,M,X,Y,E,M,IP) WILL NOT STL 556 
C CAUSE PROBLEMS PROVIDED THAT STL 56@ 
C EITHER A CONTINUOUS APPROXIMATION IS STL 570 
C REQUESTED, OR E IS A SUFFICIENTLY LARGE STL 58¢ 
C ARRAY, STL 59¢ 
C THE PROGRAM PERFORMS THE FOLLOWING DATA STL 600 
C CHECKS. ARE THE X-VALUES IN INCREASING STL 61¢ 
C ORDER. ARE THE‘TOLERANCE(S) NONNEGATIVE. STL 62@ 
C IS THE NUMBER OF DATA POINTS GREATER THAN STL 630 
C ONE. IF ANY CHECK FAILS, THE PROGRAM STL 64¢ 
C RETURNS WITH K SET EQUAL TO @. IN THIS STL 65¢ 
C CASE NO FURTHER PROCESSING IS ATTEMPTED. STL 660 
DIMENSION X(9), Y(9), E(9), U(9), V(9), W(9) STL 67@ 
N=M STL 680 
ITCH = IP STL 69¢ 


Jel STL 70¢ 
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C ERROR CHECKS 


19 


IF (N.LE.1) GO TO 466 
IF (E(1).LT.0.@) GO TO 4¢¢ 
DO 10 L=2,N 
IF (X(L-1).GE.X(L)) GO TO 46¢ 
IF (ITCH.GE.%) GO TO 1¢ 
IF (E(L).LT.@.@) GO TO 460 
CONTINUE 


C INITIALIZATION FOR ENTIRE PROGRAM 


EPSLN = E(1) 


SGN = 1.¢ 
KEEP = 1 
I=l 
UC1l) = X(1) 
J=2 
INIT = 1 
INDC = @ 
GO TO 3¢ 
C INITIALIZATION FOR EACH SEGMENT 

20 CONTINUE 
J=J+1 
INIT = I 
INDC = @ 


IF (IABS (ITCH) .LT.3) KEEP = I 
IF (IABS(IABS(ITCH)-4) .NE.2) GO TO 30 


C RESTRICTED TO TOLERANCE BAND 


XEYE = U(J-1) 
YEYE = V(J-1) 
TEMP1 = EPSLN 
IF (ITCH.LT.@) TEMP1 = TEMP1 + (SGN*E(I-1)-EPSLN)*(X(I)-U(J-1) 


* )/(X(1)-X(I-1)) 


3 
C NOT 


49 


50 


YINIT = YEYE - TEMP1 - TEMP1 

GO TO 46 

CONTINUE 

RESTRICTED TO TOLERANCE BAND 

XEYE = X(I) 

YEYE = Y(I) + EPSLN 

YINIT = Y(I) - EPSLN 

IF (IABS(ITCH) .EQ.1 .OR. I.EQ.1) GO TO 46 
TEMP1 = EPSLN 

IF (ITCH.LT.@) TEMP1 = SGN*E(I+1) 

SMIN = (Y(I+1)-YEYE-TEMP1) / (X(I+1)-XEYE) 
IF (ITCH.LT.@) TEMP1 = SGN*E(I-1) 

SMAX = (YEYE-Y(I-1)+TEMP1) / (XEYE-X(I-1)) 
IF (KEEP.EQ.I-1) GO TO 50 

IT#1I-2 

XINIT = XEYE 

IPIV = I 
IGRAZE = 
T=1l+1 
GO TO 15¢ 
CONTINUE 
IF (XEYE.GE.X(I)) L=I+1 

IF (ITCH.LT.@) EPSLN = SGN*E(1) 
DX = X(I) - XEYE 

SMAX = (Y(I)+EPSLN-YEYE) /DX 
SMIN = (Y(1)-EPSLN-YEYE) /DX 
CONTINUE 

XINIT = XEYE 

IPIV = 1 

IGRAZE = I 


I 


C DETERMINATION OF INDIVIDUAL SEGMENT 


60 


70 


CONTINUE 
IF (I.EQ.N) GO TO 26¢ 
IT=I+1 
CONTINUE 


C TEST FOR NEW *MAX* SLOPE 


86 


DX = X(I) - XEYE 

IF (ITCH.LT.@) EPSLN = SGN*E(I) 
TEMP] = (Y(1)+EPSLN-YEYE) /DX 
TEST = TEMP1 - SMAX 

IF (SGN.LE.@.@) TEST = -TEST 

IF (TEST) 80, 96, 100 

CONTINUE 


C TEST FOR END OF CANDIDATE SEGMENT 


STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 

STL 

STL 
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STL 
STL 
STL 
STL 
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STL 
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STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 

STL 

STL 

STL 


71¢ 
720 
730 
740 
750 
760 
77@ 
780 
790 
800 
81¢ 
826 
830 
840 
850 
860 
870 
880 
890 
900 
916 
920 
930 
940 
950 
960 
970 
980 
990 
1000 
161¢ 
1920 
103@ 
1646 
1650 
1960 
1070 
1980 
199¢ 
1106¢ 
111¢ 
1120 
1130 
1140 
115¢ 
1160 
1170 
1180 
119¢ 
1200 
1210 
1220 
1230 
1240 
1250 
1260 
1270 
1280 
129¢ 
1300 
131¢ 
132@ 
1330 
1340 
1350 
1360 
1370 
1380 
1390 
1400 
1416 
1420 
143¢ 
144¢ 
145@ 
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COLLECTED ALGORITHMS (cont.) 


90 


TEST = TEMP1 - SMIN 

IF (SGN.LE.@.@) TEST = -TEST 
IF (TEST.LT.@.6) GO TO 210 
SMAX = TEMP1 

CONTINUE 


C TEST FOR NEW *MIN* SLOPE 


100 


110 


126 


130 


IPIV = I 

CONTINUE 

TEMP2 = (Y¥(I)-EPSLN-YEYE) /DX 
TEST = TEMP2 - SMAX 

IF (SGN.LE.@.@) TEST = -TEST 
IF (TEST) 114, 126, 144 
CONTINUE 

TEST = SMIN - TEMP2 

IF (SGN.LE.@.0) TEST = -TEST 
IF (TEST) 120, 130, 60 
CONTINUE 

SMIN = TEMP2 

CONTINUE 

IGRAZE = I 

GO TO 6 


C CHECK FOR PIVOT AT NEW EYE POINT 


14 


150 


160 
170 


180 
19¢ 
260 


C END 
210 


22¢ 


CONTINUE 

IF (XEYE.EQ.X(IPIV)) GO TO 226 

IF (ITCH.LT.@) EPSLN = SGN*E(IPIV) 
INDC = 1 


SVX = XEYE 

SVY = YEYE 

SVMN = SMIN 

SVMX = SMAX 

XEYE = X(IFIV) 

YEYE = Y(IPIV) + EPSLN 

SMIN = SMAX 

SMAX = (YINIT-YEYE) / (XINIT-XEYE) 


IF (KEEP.GE.IPIV) GO TO 1706 

IT = IPIV - 1 

CONTINUE 

TEMP2 = YEYE + EPSLN 

DO 16¢ L=KEEP,IT 
IF (ITCH.LT.@) TEMP2 = YEYE + SGN*E(L) 
TEMP1 = (Y(L)-TEMP2) /(X(L)-XEYE) 
TEST = TEMP1 - SMAX 
IF (SGN.LE.@.@) TEST = -TEST 
IF (TEST.LT.@.@) SMAX = TEMP] 

CONTINUE 

CONTINUE 

IF (IPIV.GE.I-1) GO TO 70 

IT=I-2 

TEMP2 = YEYE - EPSLN 

IDIOT = IPIV 

DO 20@ L=IDIOT,IT 
DX = X(L+1) - XEYE 
IF (ITCH.LT.@) TEMP2 = YEYE - SGN*E(L+1) 
TEMP1 = (Y(L+1)-TEMP2) /DX 
TEST = TEMP1 - SMAX 
IF (SGN.LE.@.@) TEST = -TEST 
IF (TEST) 186, 196, 2060 
CONTINUE 
SMAX = TEMP1 
CONTINUE 
IPIV=L+l1 

CONTINUE 

GO TO 7¢ 

OF CURRENT SEGMENT 

CONTINUE 

TEMP2 = SMIN 

IF (1.EQ.N) GO TO 240 

KEEP = IGRAZE 

GO TO 25¢ 

CONTINUE 

TEMP2 = SMAX 

IF (1.EQ.N) GO TO 23¢ 


SGN = -SGN 
EPSLN = -EPSLN 
KEEP = IPIV 


GO TO 25¢ 


STL 


STL 


STL 


STL 
STL 


STL 
STL 


STL 
STL 


STL 
STL 


1466 
1470 
148¢ 
1490 
156@ 
1510 
152¢ 
1530 
1540 
155¢@ 
1560 
1570 
158@ 
159¢ 
1600 
1610 
1620 
1630 
164@ 
1650 
1660 
1676 
168¢ 
169¢ 
170¢ 
1710 
172¢ 
1730 
1740 
175@ 
1760 
1770 
1780 
1790 
1800 
181@ 
1826 
1830 
184¢ 
185¢ 
1860 
187@ 
188¢ 
189¢ 
19¢¢ 
191¢ 
192@ 
1930 
194¢ 
195@ 
1960 
1970 
198¢ 
1990 
2000 
2010 
2020 
2030 
2040 
2056 
2060 
2070 
2080 
2690 
21060 
2110 
2120 
213¢ 
2146 
2150 
2160 
217¢ 
2180 
2190 
22060 
2216 
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COELECTED ALGORITHMS (cont.) 


236 


240 


250 


CONTINUE 

IF (INDC.EQ.@ .OR. XEYE.NE.X(N-1)) GO TO 2406 
XEYE = SVX 

YEYE = SVY 

SMIN = SVMN 

SMAX = SVMX 

CONTINUE 


U(J) = X(N-1) 

YINIT = Y(N-1) 

GO TO 276 

CONTINUE 

IF (IABS(IABS(ITCH)-4) .NE.2) GO TO 3¢¢ 


C DETERMINE KNOT ON EDGE OF TOLERANCE BAND 


260 


270 


TEMP1 = @.0 

IF (ITCH.LT.@) TEMP1 = EPSLN - SGN*E(I-1) 

TEMPL = (¥(1)-Y(I-1)+TEMP1) /(X(I)-X(I-1)) 

U(J) = (Y¥(1)+EPSLN-YEYE-TEMP1*X (1)+TEMP2*XEYE) / (TEMP 2-TEMP 1 ) 
GO TO 310 

CONTINUE 

U(J) = X(N) 

YINIT = Y(N) 

CONTINUE 


C CONTINUITY CHECK FOR LAST SEGMENT 


LF (IABS(ITCH).GE.3 .OR. INIT.EQ.1) GO TO 290 
IT = INIT - 1 
SVMK = SMAX + SGN 
TEMP2 = YEYE + EPSLN 
DO 28@ L=KP,IT 
IF (ITCH.LT.@) TEMP2 = YEYE + SGN*E(L) 
TEMP] = (Y(L)-TEMP2) / (X(L)-XEYE) 
TEST = TEMP1 - SVMX 
IF (SGN.LE.@.@) TEST = -TEST 
IF (TEST.LT.@.@) SVMX = TEMP1 


280 CONTINUE 


290 


IF (ABS (SVMX-SMAX+SVMX-SMIN) .LE.ABS (SMAX-SMIN)) SMAX = SVMX 
CONTINUE 


C NEARNESS CHECK FOR LAST SEGMENT 


300 


310 


320 


336 


TEMP2 = SMAX 

TEMP1 = YEYE + SMAX*(U(J)-XEYE) 
TEST = YINIT - TEMP1 

IF (SGN.LT.@.@) TEST = -TEST 

IF (TEST.GT.@.6) GO TO 310 
TEMP2 = SMIN 

TEMP1 = YEYE + SMIN*(U(J)-XEYE) 
TEST = YINIT - TEMP1 

IF (SGN.LT.@.@) TEST = -TEST 
IF (TEST.LT.@.6) GO TO 310 
TEMP2 = (YINIT-YEYE) /(U(J)-XEYE) 
V(J) = YINIT 

GO TO 32¢ 

CONTINUE 

IF (IABS(ITCH).GE.3) GO TO 33@ 
U(J) = @.5*(X(1)+X(I-1)) 
CONTINUE 

V(J) = YEYE + TEMP2* (U(J)-XEYE) 
CONTINUE 

IF (XEYE.NE.XINIT) GO TO 33@ 
IF (IABS (ITCH) .EQ.2) GO TO 36¢ 
IF (IABS(ITCH) .NE.6) GO TO 33¢ 
IF (J.LE.2) GO TO 38¢ 

GO TO 39¢ 

CONTINUE 


C RECOMPUTATION OF KNOT FOR CONTINUITY 


IF (J.LE.2) GO TO 37¢ 
IF (SLOPE.EQ.TEMP2) GO TO 36¢ 
YINIT = V(J-2) 
IF (IABS(ITCH).LT.3) YINIT = W(J-2) 
TEMP1 = (XEYE*TEMP2-U (J-2)*SLOPE+YINIT-YEYE) / (TEMP2-SLOPE) 
IF (IABS(ITCH).GE.3) GO TO 35¢@ 
IF (TEMP1.GT.XINIT) GO TO 360 
TEST = ABS (EPSLN) 
IDIOT = INIT - KP 
DO 34@ L=1,IDIOT 
IT = INIT - L 
IF (TEMP1.GE.X(IT)) GO TO 35@ 
DX = Y(IT) ~- YEYE - TEMP2*(X(IT)-XEYE) 


STL 
STL 


STL 


STL 


STL 


STL 


STL 
STL 


2220 
2230 
2240 
2250 
2260 
2270 
2280 
2290 
2300 
2310 
2320 
2330 
2346 
2350 
2360 
2370 
2386 
2390 
2400 
2410 
2420 
2430 
2440 
2450 
2460 
2470 
2480 
2490 
2500 
2510 
2520 
2530 
2540 
2550 
2560 
2570 
2580 
259@ 
2600 
2610 
2620 
2630 
2640 
2650 
2660 
2670 
2680 
2690 
2700 
271 
2720 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
2800 
281@ 
2820 
2830 
2840 
2850 
2860 
2870 
2880 
2890 
2900 
2910 
292@ 
2930 
2940 
2950 
2960 
2970 
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COLLECTED ALGORITHMS (cont.) 


IF (ITCH.LT.@) TEST = E(IT) 
IF (ABS(DX).GT.TEST) GO TO 36 


34@ CONTINUE 


350 


366 


370 
380 
396 


400 


CONTINUE 
U(J-1) = TEMP1 

V(J-1) = YEYE + TEMP2* (U(J-1)-XEYE) 
IF (IABS(ITCH) .LT.3) W(J-1) = V(J-1) 
GO TO 39¢ 

CONTINUE 

W(J-1) = YEYE + TEMP2*(U(J-1)-XEYE) 
GO TO 39¢ 

CONTINUE 

IF (IABS(ITCH).LT.3) GO TO 36¢@ 
CONTINUE 

V(1) = YEYE + TEMP2*(U(1)-XEYE) 
CONTINUE 

SLOPE = TEMP2 

KP = KEEP 

IF (I.LT.N) GO TO 26 

IF (X(N) .EQ.U(J)) GO TO 406¢ 

IF (IABS(ITCH).LT.3) W(J) = V(J) 
J=J+l 

U(J) = X(N) 

V(J) = Y(N) 

CONTINUE 

IF (J.GE.2 .AND. IABS(ITCH).LT.3) V(1) = W(1) 
K=J-1 

RETURN 

END 


STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 
STL 


2980 
2990 
3000 
3010 
3020 
3030 
3046 
3050 
3060 
3070 
3080 
3090 
3100 
3110 
312¢ 
313¢ 
314@ 
315@ 
316¢ 
317¢ 
3180 
319¢ 
3200 
321¢ 
3220 
323¢ 
3240 
325 
3260 
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COLLECTED ALGORITHMS FROM ACM 
511-P 1- 0 


ALGORITHM _ 511 
CDC 6600 Subroutines IBESS and JBESS 
for Bessel Functions 


L(x) and J,(x),x 20,v20 [S18] 


D. E. AMOS, S. L. DANIEL, and M. K. WESTON 
Sandia Laboratories 


Key Words and Phrases: Bessel functions of the first kind, modified Bessel function, 
Airy functions, uniform asymptotic expansion 

CR Categories: 5.12 

Language: Fortran 


DESCRIPTION 


This algorithm is a complement to [1], where the theoretical background and de- 
velopment are described. 


REFERENCES 


1. Amos, D.E., Dantret, 8.L., AND Weston, M.K. CDC 6600 Subroutines IBESS and JBESS 
for Bessel Functions J,(z) and J,(z), « > 0,v => 0. ACM Trans. Math. Software 8, 1 
(March 1977), 76-92. 


ALGORITHM 

FUNCTION GAMLN(X) GAM =s-:10 
Cc GAM 20 
Cc A CDC 666@ SUBROUTINE GAM 30 
Cc GAM 4@ 
a AUTHORS GAM 59 
Cc D.E. AMOS AND S.L. DANIEL GAM 60 
Cc ALBUQUERQUE, NEW MEXICO, 87115 GAM 70 
6 JANUARY, 1975 GAM 89 
C GAM 9¢ 
Cc REFERENCES GAM 10¢@ 
c ABRAMOWITZ, M. AND STEGUN, I.A. HANDBOOK OF MATHEMATICAL GAM 116 
Cc FUNCTIONS. NBS APPLIED MATHEMATICS SERIES 55, U.S. GOVERNMENT GAM 120 
Cc PRINTING OFFICE, WASHINGTON, D.C., CHAPTER 6. GAM 13@ 
Cc GAM 14¢ 
Cc AMOS, D.E., DANIEL, S.L. AND WESTON, M.K. CDC 6600 GAM 15@ 
c SUBROUTINES IBESS AND JBESS FOR BESSEL FUNCTIONS GAM 16@ 
Cc I/SUB(NU)/(X) AND J/SUB(NU)/(X), X.GE.@, NU.GE.@. GAM 170 
Cc ACM TRANS. MATH. SOFTWARE, 1977. GAM 18@ 
C GAM 19¢ 
€ HART, J.F., ET. AL. COMPUTER APPROXIMATIONS, WILEY, NEW YORK. GAM 2¢@ 
c PP. 130-136, 1968. GAM 210 
Cc GAM 220 
C ABSTRACT GAM 230 
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COLLECTED ALGORITHMS (cont.) 


Cc GAMLN COMPUTES THE NATURAL LOG OF THE GAMMA FUNCTION FOR GAM 
Cc X.GT.@. A RATIONAL CHEBYSHEV APPROXIMATION IS USED ON GAM 
Cc 8.LT.X.LT.160@., THE ASYMPTOTIC EXPANSION FOR X.GE.10@@. AND GAM 
Cc BACKWARD RECURSION FOR @.LT.X.LT.8 FOR NON--INTEGRAL X. FOR GAM 
C X=1.,...,8., GAMLN IS SET TO NATURAL LOGS OF FACTORIALS. GAM 
C GAM 
C DESCRIPTION OF ARGUMENTS GAM 
C GAM 
Cc INPUT GAM 
¢ X - X.GT.@ GAM 
Cc GAM 
Cc OUTPUT GAM 
GC GAMLN - NATURAL LOG OF THE GAMMA FUNCTION AT X GAM 
c GAM 
Cc ERROR CONDITIONS GAM 
Cc IMPROPER INPUT ARGUMENT - A FATAL ERROR GAM 
DOUBLE PRECISION DXZ, RXZ, XK GAM 
DIMENSION G(8), P(5), Q(2) GAM 

DATA XLIM1 ,XLIM2,RTWPIL/ 8. , 1600. » 9.18938533204673E-01/GAM 

DATA G / 8.52516136106541E+@O, 6.5792512120101GE+00, GAM 

1 4.787491742782G65E+0@, 3.17805383034795E+0O, 1.791759469228G6E+0¢,GAM 

2 6.93147180559945E-@1, 2(9.) ; GAM 
DATA P / 7.66345188¢O0GOGE-04 ,-5.94095610520000E-04 , GAM 

1 7.936431104845Q@0E-@4,-2.77777775657725E-03, 8.33333333333169E-02/GAM 

DATA Q /-2.77777777777778E-063, 8.33333333333333E-02/GAM 

IF (X) 146, 146, 10 GAM 

1@ DX = X - XLIM1 GAM 

IF (DX) 2¢, 116, 8@ GAM 

20 IF (X-1.) 36, 134, 40 GAM 

30 XZ =X + 8. GAM 

TX = X GAM 

FK = -.5 GAM 

NDX = 7 GAM 

GO TO 5¢ GAM 

406 DX = ABS(DX) GAM 
NDX = DX GAM 

DNDX = NDX GAM 

NDX = NDX + 1 GAM 

IF ((DNDX-DX) .EQ.@.) GO TO 12¢ GAM 

XZ = X + DNDX + l. GAM 

T = 1. GAM 

FK = .5 GAM 

50 DXZ = XZ GAM 
RXZ = 1.D+@/DXZ GAM 

RX = RXZ GAM 

RXX = RX*RX GAM 

XK = 1.D+¢ GAM 

DO 6¢@ I=1,NDX GAM 

XK = XK - RXZ GAM 

SXK = XK GAM 

TX = TX*SXK GAM 

60 CONTINUE GAM 
SUM = (X-FK)*ALOG(XZ) - ALOG(TX) - XZ GAM 

PX = P(1) GAM 

DO 7@ I=2,5 GAM 

PX = PX*RXX + P(I) GAM 

7@ CONTINUE GAM 
GAMLN = PX*RX + SUM + RTWPIL GAM 
RETURN GAM 

8@ RX = 1./X GAM 
RXX = RX*RX GAM 

IF ((X-XLIM2).LT.@.) GO TO 9¢ GAM 

PX = Q(1)*RXX + Q(2) GAM 
GAMLN = PX*RX + (X-.5)*ALOG(X) - X + RTWPIL | GAM 
RETURN GAM 

96 PX = P(1) GAM 
SUM = (X-.5)*ALOG(X) - X GAM 

DO 10@ I=2,5 GAM 

PX = PX*RXX + P(I) GAM 

166 CONTINUE GAM 
GAMLN = PX*RX + SUM + RTWPIL GAM 
RETURN GAM 

110 GAMLN = G(1) GAM 
RETURN GAM 

126 GAMLN = G(NDX) GAM 
RETURN GAM 
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13@ GAMLN = G(8) GAM 1600 
RETURN GAM 14106 
14@ PRINT 99999, xX GAM 1620 
STOP GAM 1030 
99999 FORMAT (5@H ARGUMENT FOR GAMLN IS LESS THAN OR EQUAL TO ZERO,, GAM 1040 
* 3H X=,E25.14) GAM 1050 
END GAM 1060 
SUBROUTINE IBESS(KODE, ALPHA, N, X, Y) IBE 10 
IBE 20 

A CDC 660¢ SUBROUTINE IBE 30 

IBE 40 

AUTHORS IBE 5@ 
D.E. AMOS AND S.L. DANIEL IBE 6 
SANDIA LABORATORIES IBE 7¢ 
JANUARY, 1975 IBE 8@ 

IBE 9@ 

REFERENCES IBE 140 
ABRAMOWITZ, M. AND STEGUN, I.A. HANDBOOK OF MATHEMATICAL IBE 110 
FUNCTIONS. NBS APPLIED MATHEMATICS SERIES 55, U.S. GOVERNMENT IBE 120 
PRINTING OFFICE, WASHINGTON, D.C., CHAPTERS 9 AND 1@. IBE 130 

IBE 14¢ 

AMOS, D.E., DANIEL, S.L. AND WESTON, M.K. CDC 6600 IBE 150 
SUBROUTINES IBESS AND JBESS FOR BESSEL FUNCTIONS IBE 160 
I/SUB(NU)/(X) AND J/SUB(NU)/(X), X.GE.@, NU.GE.@. IBE 17¢ 

ACM TRANS, MATH. SOFTWARE, 1977. IBE 18@ 

IBE 190 

OLVER, F.W.J. TABLES FOR BESSEL FUNCTIONS OF MODERATE OR IBE 26¢ 
LARGE ORDERS. NPL MATHEMATICAL TABLES, VOL 6. HER MAJESTY-S IBE 210 
STATIONERY OFFICE, LONDON, 1962. IBE 220 

IBE 230 

OLVER, F.W.J. THE ASYMPTOTIC EXPANSION OF BESSEL FUNCTIONS OF IBE 24@ 
LARGE ORDER. PHIL. TRANS. A, 247, PP. 328-368, 1954. IBE 25¢ 

IBE 260 

ABSTRACT IBE 27¢ 
IBESS COMPUTES AN N MEMBER SEQUENCE OF I BESSEL FUNCTIONS IBE 28¢ 


I/SUB(ALPHA+K-1)/(X), K=1,...,N OR SCALED BESSEL FUNCTIONS IBE 290 
EXP (-X)*I/SUB(ALPHA*K-1)/(X), K=1,...,N FOR NON-NEGATIVE ALPHAIBE 300 


AND X. A COMBINATION OF THE POWER SERIES, THE ASYMPTOTIC IBE 310 
EXPANSION FOR X TO INFINITY, AND THE UNIFORM ASYMPTOTIC IBE 320 
EXPANSION FOR NU TO INFINITY ARE APPLIED OVER SUBDIVISIONS OF IBE 330 
THE (NU,X) PLANE. FOR VALUES NOT COVERED BY ONE OF THESE IBE 34 


FORMULAE, THE ORDER IS INCREMENTED BY AN INTEGER SO THAT ONE IBE 35@ 
OF THESE FORMULAE APPLY. BACKWARD RECURSION IS USED TO REDUCE IBE 36¢@ 
ORDERS BY INTEGER VALUES. THE ASYMPTOTIC EXPANSION FOR X TO IBE 370 
INFINITY IS USED ONLY WHEN THE ENTIRE SEQUENCE (SPECIFICALLY IBE 38@ 


THE LAST MEMBER) LIES WITHIN THE REGION COVERED BY THE IBE 399 
EXPANSION. LEADING TERMS OF THESE EXPANSIONS ARE USED TO TEST IBE 46¢ 
FOR OVER OR UNDERFLOW WHERE APPROPRIATE. IF A SEQUENCE IS IBE 41 
REQUESTED AND THE LAST MEMBER WOULD UNDERFLOW, THE RESULT IS IBE 42@¢ 
SET TO ZERO AND THE NEXT LOWER ORDER TRIED, ETC., UNTIL A IBE 43¢ 
MEMBER COMES ON SCALE OR ALL ARE SET TO ZERO. AN OVERFLOW IBE 44¢ 
CANNOT OCCUR WITH SCALING. IBESS CALLS FUNCTION GAMLN. IBE 45¢ 
IBE 460 

DESCRIPTION OF ARGUMENTS IBE 47@ 
IBE 48@ 

INPUT IBE 49¢ 
KODE - A PARAMETER TO INDICATE THE SCALING OPTION IBE 50@ 
KODE=1 RETURNS IBE 519 

Y(K)= IL/SUB(ALPHA+K=1) /(X), IBE 52¢ 

K=1,...,N IBE 530 

KODE=2 RETURNS IBE 54@ 

Y (K) =EXP (-X) *1/SUB (ALPHA+K-1) /(X), IBE 55¢ 

Kad, csregN IBE 56¢ 

ALPHA -—- ORDER OF FIRST MEMBER OF THE SEQUENCE, ALPHA.GE.@ IBE 570 

N - NUMBER OF MEMBERS IN THE SEQUENCE, N.GE.1 IBE 58¢ 

X ~ X.GE.¢@ IBE 59¢ 
IBE 600 

OUTPUT IBE 610 
Y - A VECTOR WHOSE FIRST N COMPONENTS CONTAIN IBE 62¢ 
VALUES FOR I/SUB(ALPHAtK-1)/(X) OR SCALED IBE 630 

VALUES FOR EXP (-X)*1I/SUB(ALPHA+K~-1) /(X), IBE 640 

K=1,...,N DEPENDING ON KODE IBE 65¢ 

IBE 660 


ANQAAAAAAAAAAAAANAAAAANQIAANAAAAAARAAAAAANADAAANDQDANQNAAAARAAAARNAIAANANARAAMAAMNAMAAANAAANAAANAANAA 


ERROR CONDITIONS IBE 670 
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aAaAaAnD 


IMPROPER INPUT ARGUMENTS ~- A FATAL ERROR 


OVERFLOW WITH KODE=1 


- A FATAL ERROR 


UNDERFLOW - A NON-FATAL ERROR 


DOUBLE PRECISION DX, TRX, DTM, DFN 
DIMENSION Y(1), TEMP(3) 
DIMENSION C(11,14) 

DIMENSION C1(11,8), C2(11,2) 
EQUIVALENCE (C(1,1),C1(1,1)) 
EQUIVALENCE (C(1,9),C2(1,1)) 
DATA ELIM,TOL 


DATA RTPI,RITPI 
DATA CE 


Be 
[Ds 


DATA INLIM 


DATA Cl 


7 


ioe) 


DNS ND 


mamta o . fee) a OUYNANMNRwWNE 
i 


NOUN PE ONE 


/-2. 


9(0.) » 3. 


- 93125900000000E-02, 
1.84646267361111E+60,-8. 


7.) » 4. 


- 78912353515625E+9@, -2. 


6(0.) y—2. 


-181824154324QG0E+01, 4. 
-27168061708984E-@1, 

-65252468141182E+62, 1 
-18199511744212E+@2,-2. 


4(0.) gals 


-35865500064341E+O4, 1. 
- 26090291321635E+O3,-1. 
-02042913309661E+04,-9. 


3(0.) uae 


-92547001232532E+O5 ,-2. 
.11926549688976E+04, 7. 
-97404200127348E+00, 


/-2. 


-99861591853811E+6, 3. 
- 26836527332162E+G6,-3. 
-49983048181121E+O3, 2. 
-28446985307204E+06,-1. 
-41951482115327E+@7, 6. 
- 3288767166421 8E+97,-2. 
-3886989753717G0Et+94, 1. 


C TEST INPUT ARGUMENTS 


KT 


=1 


C TEST INPUT ARGUMENTS 


IF 
1¢ KT 
20 NN 
IF 
IF 
3¢ IF 
40 
IF 


5¢ 
60 


70 


DO 


(N-1) 5806, 106, 20 
= 2 

=N 
(KODE.LT.1 
(X) 590, 30, 80 
(ALPHA) 57@¢, 40, 50 


Y¥(1) = 1. 


(N.EQ.1) RETURN 


7@ I=I1,N 


Y(I) = @. 
CONTINUE 


RETURN 


80 


CONTINUE 


- 0599904525 28QGE+O3 ,-6 


667. 
59154943091895E-@1, 3 
45387763900OOOE+O1 / 
8¢ / 
$8333333333333E-@1, 1. 
34201388888889E-01,-4. 
8(0.) wl 
9121693750000GE-01, 7. 
66958442342625E+00,-1. 
36408691406250E+00, 1. 
82120725582GG2E+O1, 8. 
25349987453885E+@1 ,-7 
5(@.) » 2. 


64914394869516E+O1, 5. 
91945766231841E+O3, 8. 
16553933368645E+04,-5. 
08699919788395E+O2, 1. 


03400177280416E+O5, 1. 
109514302489 36E+O3 ,-4 
2(¢.) / 
4291918790@551E+O5, 1. 
7632712976564GE+G6 ,-2 
31645172484564E+O5, 4 
438905296995561E+@1, 
979068191184322E+97, 5 
6344512274729GE+97 ,-3. 
78561812808645E+06, 3. 
10017140269247E+92/ 


-OR. KODE.GT.2) GO TO 560 


IF (ALPHA.LT.@.) GO TO 57@ 
DFN = DBLE(FLOAT(N)) + DBLE(ALPHA) - 1.D+@ 


FNU = DFN 
IN=@ 
XO2 = X*.5 


SXO02 = X02*X02 
ETX = KODE - 1 


SX 


C DECISION TREE FOR REGION WHERE SERIES, ASYMPTOTIC EXPANSION FOR X 
C TO INFINITY AND ASYMPTOTIC EXPANSION FOR NU TO INFINITY ARE 


= ETX*X 


C APPLIED. 
IF (SX02.LE.(FNU+1.)) GO TO 9¢ 


IF 
FN 
FN 
IF 
NS 


(X.LE.12.) GO TO 119 
= 0.55*FNU*FNU 

= AMAX1(17.,FN) 
(X.GE.FN) GO TO 43¢ 
= AMAX1 (36.-FNU,@.) 


IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 


1.E~15 /IBE 


-98942280401433E-01/IBE 


IBE 

IBE 
250000000OOO0OE-O1, BE 
01041666666667E-@1, IBE 


-02581259645062E+00, IBE 


324218750G00O0E-02, LBE 
1207002616223GE+@1 , IBE 
12152099669375E-@1, IBE 
46362176746007E+@1,IBE 


-36879435947963E+00, IBE 


1257013003921 7E+92, IBE 


-99579627376133E+02, IBE 


72501420974731E-01,IBE 
$6172218173731E+03, IBE 
30656469786134QE+03, IBE 
72772750258446E+00, IBE 
69805983886375E+04, LBE 
22200464983017E+@5, IBE 


-93915304773088E+@2, IBE 


IBE 
31176361466298E+@6, IBE 


.81356322658653E+@6, IBE 
-52187689813627E+04, TBE 


1(@.) , [BE 


-99526024926646E+07, IBE 


75671766607634E+@7 , IBE 
$8186404612662E+@5, IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
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COLLECTED ALGORITHMS (cont.) 


9¢ 


100 


11¢ 


120 


C OVERFLOW TEST ON UNIFORM ASYMPTOTIC EXPANSION 


139 


C UNDERFLOW TEST ON UNIFORM ASYMPTOTIC EXPANSION 


146 


15¢ 


C UNIFORM ASYMPTOTIC EXPANSION FOR NU TO INFINITY 


160 


176 


180 


199 


20¢ 


210 


DFN = DFN + DBLE(FLOAT(NS)) 


FN = DEN 

IS = KT 

KM = N - 1+ NS 

IF (KM.GT.@) IS = 3 
GO TO 12¢ 

FN = FNU 


FNP] = FN + 1. 

XO2L = ALOG(X02) 

IS = KT 

IF (X.LE.@.5) GO TO 23¢ 
NS = @ 

DFN = DFN + DBLE(FLOAT(NS) ) 
FN = DEN 

FNP] = FN + lL. 

IS = KT 

IF (N-1+NS.GT.6) IS = 3 
GO TO 23¢ 


X02L = ALOG (X02) 
NS = SXO2 - FNU 
GO TO 10¢ 
CONTINUE 


IF (KODE.EQ.2) GO TO 13 

IF (ALPHA.LT.1.) GO TO 15@ 
Z = X/ALPHA 

RA = SQRT(1.+Z*Z) 

GLN = ALOG((1.+RA) /Z) 

T = RA*(1.-ETX) + ETX/(Z+RA) 
ARG = ALPHA*(T-GLN) 

IF (ARG.GT.ELIM) GO TO 606¢ 
IF (KM.EQ.0) GO TO 14¢ 
CONTINUE 


Z = X/FN 

RA = SQRT(1.+2Z*Z) 

GLN = ALOG((1.+RA)/Z) 

T = RA*(1.-ETX) + ETX/(Z+RA) 
ARG = FN*(T-GLN) 

IF (ARG.LT.-ELIM) GO TO 28¢ 
GO TO 190 

IF (X.GT.ELIM) GO TO 6¢¢ 

GO TO 136 


IF (KM.NE.@) GO TO 17 
Y(1) = TEMP (3) 


RETURN 

TEMP (1) = TEMP (3) 
IN = NS 

KT = 1 

CONTINUE 

IS = 2 

DFN = DFN - 1.D+@ 
FN = DFN 

Z = X/FN 


RA = SQRT(1.+Z%*Z) 
GLN = ALOG((1.+RA) /Z) 
T = RA*(1.-ETX) + ETX/(Z+RA) 
ARG = FN*(T--GLN) 
COEF = EXP (ARG) 
T= 1./RA 
T2 = TAT 
T = T/FN 
$2 = 1. 
AP = l. 
DO 210 K=1,1¢@ 

KP1 =K+1 

$1 = C(1,K) 

DO 2¢¢ J=2,KP1 

Sl = S1*T2 + C(J,K) 


CONTINUE 

AP = AP*#T 
AK = AP*S1 
$2 = S2 + AK 


IF (ABS(AK).LT.TOL) GO TO 22¢ 


CONTINUE 


IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 


144¢ 
145¢ 
1460 
1479 
148@ 
149¢ 
150¢ 
151¢ 
152@ 
153@ 
154@ 
155¢ 
156@ 
157@ 
158@ 
159¢ 
1600 
161¢ 
162¢ 
163¢ 
1640 
1650 
166¢ 
167¢ 
168¢ 
1690 
1706¢ 
171¢ 
172@ 
1730 
174@ 
175@ 
176@ 
177¢ 
178@ 
179@ 
180¢ 
1810 
182¢ 
183@ 
184¢ 
185@ 
186@ 
187¢ 
188¢ 
189¢ 
1900 
191¢ 
192¢ 
1930 
194¢ 
1950 
1960 
1979 
198¢ 
199¢ 
2000 
2010 
2020 
203¢ 
2040 
2050 
2060 
2070 
2080 
209¢ 
21066 
211¢ 
212¢ 
2130 
2146 
215¢ 
2160 
2170 
2180 
2190 
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COLLECTED ALGORITHMS (cont.) 


220 


CONTINUE 
TEMP (IS) = SQRT(T*RTPL)*COEF*S2 
GO TO (184, 35@, 500), IS 


C SERIES FOR (X/2)**2.LE.NU+1 


230 


249 


250 
260 


270 


C SET 


280 


290 


300 


310 
320 


330 


346 


CONTINUE 

GLN = GAMLN(FNP1) 

ARG = FN*X02L - GLN - SX 

IF (ARG.LT.-ELIM) GO TO 3@@ 
EARG = EXP (ARG) 

CONTINUE 


DO 25@ K=1,17 
S2 = 1T2 + Sl 
T = T*SX02/S2 
S=S+T 
IF (ABS(T).LT.TOL) GO TO 26¢ 
T2 = T2 + AK 
AK = AK + 2. 
Sl = Sl + FN 
CONTINUE 
CONTINUE 
TEMP (IS) = S*EARG 
GO TO (27¢, 356, 490), IS 
EARG = EARG*FN/X02 
DFN = DEN - 1.D+@ 
FN = DFN 
Is = 2 
GO TO 24¢ 


UNDERFLOW VALUE AND UPDATE PARAMETERS 


Y(NN) = @. 

NN = NN - 1 

DFN = DFN - 1.D+@ 

FN = DEN 

IF (NN-1) 34@, 29¢, 139 

KT = 2 

Is = 2 

GO TO 13¢ 

Y(NN) = @. 

NN = NN - 1 

FNP1 = FN 

DFN = DFN - 1.D+@ 

FN = DFN 

LF (NN-1) 340, 3106, 320 

KT = 2 

IS = 2 

IF (SX02.LE.FNP1) GO TO 33¢ 
GO TO 13¢ 

ARG = ARG - XO2L + ALOG(FNP1) 
IF (ARG.LT.-ELIM) GO TO 30@ 
GO TO 23¢ 

NZ = N - NN 


PRINT 99994, NZ, KODE, ALPHA, N, X 


RETURN 


C BACKWARD RECURSION SECTION 


350 


366 
379 


CONTINUE 
NZ = N - NN 


IF (NZ.NE.@) PRINT 99994, NZ, KODE, ALPHA, N, X 


GO TO (370, 420), KT 
CONTINUE 


S2 = TEMP (2) 

DX = 

TRX = 2.D+@/DX 

DIM = DFN*TRX 

T™ = DIM 

IF (IN.EQ.@) GO TO 39@ 


C BACKWARD RECUR TO INDEX ALPHA+NN-1 


DO 38¢ I=1,IN 


8S = 82 
S2 = TM*S2 + Sl 
Sl = § 


DIM = DIM - TRX 


IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 


IBE. 


IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 


22060 
2210 
2220 
2230 
2240 
225¢ 
2260 
2270 
2280 
2290 
2300 
231@ 
2320 
2330 
2340 
2350 
2360 
2370 
238¢ 
2390 
2400 
2410 
2420 
2430 
2446 
2450 
2460 
2470 
2480 
2496 
2500 
251¢ 
2526 
2530 
2546 
2550 
2560 
2570 
2580 
2590 
26060 
2610 
262¢ 
2630 
2640 
2650 
2660 
2670 
2680 
2690 
27060 
271¢ 
2720 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
2800 
2810 
2826 
2830 
2840 
2850 
2860 
2870 
2880 
289¢ 
2960 
2910 
2920 
2930 
2946 
2950 
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380 


390 


T™ = DIM 
CONTINUE 
Y(NN) = S1 
IF (NN.EQ.1) RETURN 
Y(NN-1) = S2 
IF (NN.EQ.2) RETURN 
GO TO 46¢ 
CONTINUE 


C BACKWARD RECUR FROM INDEX ALPHA+NN-1 TO ALPHA 


400 


410 
420 


Y(NN) = $1 

Y(NN-1) = S2 

IF (NN.EQ.2) RETURN 

K = NN+1 

DO 41@ I=3,NN 
K=K-1 
Y¥(K-2) = TM*Y(K-1) + Y(K) 
DIM = DIM - TRX 
T™ = DIM 

CONTINUE 

RETURN 

Y(1) = TEMP(2) 

RETURN 


C ASYMPTOTIC EXPANSION FOR X TO INFINITY 


430 


460 
470 


480 


CONTINUE 

EARG = RITPI/SQRT(X) 

IF (KODE.EQ.2) GO TO 44¢ 
IF (X.GT.ELIM) GO TO 66¢ 
EARG = EARG*EXP (X) 

ETX = 8.*X 


DTM = DX*DX 


TRX = Sl 
DX = —(DIM-1.D+@) /TRX 


-D+@ + DX 


iol LS eee ia 
oe ro 
ONnK 


82 


tou 
io] 
+ 
=] 


IF (ABS(T).LE.TOL) GO TO 479 
AK = AK + 8, 
CONTINUE 


TEMP (IS) = S*EARG 

GO TO (484, 360), IS 
Is = 2 

DFN = DFN - 1.D+@ 
GO TO 45¢ 


C BACKWARD RECURSION WITH NORMALIZATION BY 
C ASYMPTOTIC EXPANSION FOR NU TO INFINITY OR POWER SERIES. 


490 


CONTINUE 


C COMPUTATION OF LAST ORDER FOR SERIES NORMALIZATION 


KM = AMAX1(3.-FN,@.) 

TFN = FN + FLOAT (KM) 

TA = (GLN+TFN-@.9189385332-@.0833333333/TFN) / (TEN+0.5) 
XO2L - TA 

-(1.-1./TEN) /TFN 

CE/ (-TA+SQRT (TA*TA-CE*TB)) + 1.5 

IN + KM 

GO TO 51¢ 


lec 
> 
iouoa a 


Hi 
Zz 
il 


500 CONTINUE 


C COMPUTATION OF LAST ORDER FOR ASYMPTOTIC EXPANSION NORMALIZATION 


IN = CE/(GLN+SQRT (GLN*GLN+T*CE)) + 1.5 
IF (IN.GT.INLIM) GO TO 16¢ 


51@ DX = FLOAT(IN) 


DIM = DFN + DX 
DX = X 


IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 


2960 
2979 
2980 
2999 
3000 
30106 
30620 
3036 
30640 
3050 
3060 
3076 
3080 
3090 
310¢ 
311¢ 
3120 
313¢ 
3140 
315@ 
3160 
3170 
318¢ 
3190 
3200 
321¢ 
3226 
3230 
3240 
325¢ 
3266 
3279 
3286 
3290 
3300 
331¢ 
3320 
3330 
3346 
3350 
3360 
3370 
3380 
3390 
34066 
341¢ 
3426 
3430 
3449 
3450 
3460 
3470 
3480 
3499 
3500 
3510 
352¢ 
3530 
3546 
3550 
3560 
3570 
3580 
3590 
3600 
361¢ 
362¢ 
3630 
3646 
3650 
3660 
3670 
3680 
3696 
3700 
371¢ 
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2.D+@/DX 
DIM*TRX 


52@ CONTINUE 
C BACKWARD RECUR UNINDEXED 
DO 53@ I=1,IN 


S = TB 

TB = TM*TB + TA 
TA = 5S 

DTM = DTM — TRX 
TM = DIM 


530 CONTINUE 
C NORMALIZATION 
IF (KK.NE.1) GO TO 54@ 
TA = (TA/TB)*TEMP (3) 


TB = TEMP (3) 
KK = 2 
IN = NS 


IF (NS.NE.@) GO TO 520 
54@ Y(NN) = TB 
NZ = N - NN 
IF (NZ.NE.@) PRINT 99994, NZ, KODE, ALPHA, N, X 
IF (NN.EQ.1) RETURN 
TB = TM*TB + TA 
K=NN- 1 
Y(K) = TB 
IF (NN.EQ.2) RETURN 
DIM = DIM - TRX 
T™ = DIM 
KM = K - 1 
C BACKWARD RECUR INDEXED 
DO 55@ I=1,KM 
Y(K-1) = TM*Y(K) + Y(K+1) 
DIM = DTM - TRX 
TM = DIM 
K=K-1 
55@ CONTINUE 
RETURN 
56@ PRINT 99999, KODE, ALPHA, N, X 
STOP 
570 PRINT 99998, KODE, ALPHA, N, X 
STOP 
58@ PRINT 99997, KODE, ALPHA, N, X 
STOP 
59@ PRINT 99996, KODE, ALPHA, N, X 
STOP 
60@ PRINT 99995, KODE. ALPHA, N, X 
STOP 
99999 FORMAT (51H@IBESS CALLED WITH SCALING OPTION, KODE, NOT 1 OR 2 
* /6H KODE=,12,7H ALPHA=,E25.14,3H N=,16,3H X=,E25.14) 
99998 FORMAT (51H@IBESS CALLED WITH THE ORDER, ALPHA, LESS THAN ZERO 
* /6H KODE=,12,7H ALPHA=,E25.14,3H N=,16,3H X=,E25.14) 
99997 FORMAT (34H@IBESS CALLED WITH N LESS THAN ONE/6H KODE=, 
* [2,7H ALPHA=,E25.14,3H N=,16,3H X=,E25.14) 
99996 FORMAT (35H@IBESS CALLED WITH X LESS THAN ZERO/6H KODE=, 
* 12,7H ALPHA=,E25.14,3H N=,16,3H X=,E25.14) 
99995 FORMAT (42H@OVERFLOW IN IBESS, X TOO LARGE FOR KODE=1/6H KODE=, 
* 12,7H ALPHA=,E25.14,3H N=,16,3H X=,E25.14) 
99994 FORMAT (25H@UNDERFLOW IN IBESS, LAST,16,2@H VALUE(S) OF Y ARRAY, 
* 17H WERE SET TO ZERO/6H KODE=,12,7H ALPHA=,E25.14,3H N=,16, 
* 3H X=,E25.14) 
END 


SUBROUTINE JAIRY(X, RX, C, AI, DAI) 


CDC 660% ROUTINE 
1-2~74 


JAIRY COMPUTES THE AIRY FUNCTION AI(X) 
AND ITS DERIVATIVE DAI(X) FOR JBESS 
INPUT 


ANQAQDAAAN 


IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 
IBE 


JAI 
JAI 
JAI 
JAI 
JAT 
JAI 
JAI 
JAI 


511-P 8- 


0 


COLLECTED ALGORITHMS (cont.) 


ANQQAANQAAANAANRAAANNAAAOA 


JAI 

X - ARGUMENT, COMPUTED BY JBESS, X.LE.(ELIM2*1.5)**(2./3.) JAI 

RX - RX=SQRT(ABS(X)), COMPUTED BY JBESS JAI 

C - C=2.* (ABS (X)**1.5)/3., COMPUTED BY JBESS JAI 

JAI 

OUTPUT JAI 

JAI 

AI - VALUE OF FUNCTION AI(X) JAIL 
DAI - VALUE OF THE DERIVATIVE DAI(X) JAI 
JAI 

WRITTEN BY JAI 

JAI 

D. E. AMOS JAI 

Si 1. DANIEL JAI 

M. K. WESTON JAI 

JAI 

DIMENSION AJP(19), AJN(19), A(15), B(15) JAI 
DIMENSION AK1(14), AK2(23), AK3(14) JAI 
DIMENSION DAJP(19), DAJN(19), DA(15), DB(15) JAI 
DIMENSION DAK1(14), DAK2(24), DAK3(14) JAI 
DATA Nl, N2, N3, N4 /14,23,19,15/ JAL 
DATA Ml, M2, M3, M4 /12,21,17,13/ JAI 


DATA FPI12,CON2,CON3,CON4,CON5 / 1.30899693899575E+0@, JAL 
1 5.63154716196777E+00, 3.80004589867293E-61, 8.33333333333333E-@1, JAI 
2 8.66025403784439E-61/ JAL 
DATA AKI / 2.20423696987793E-01,-1.2529024278770GE-@1, JAL 
1 1.03881163359194E-02, 8.22844152006343E~04,-2.34614345891226E-@4, JAI 
2 1.63824286172116E-65, 3.069062589573189E-@7 ,-1.29621999359332E-@7, JAI 
3 8.22908158823668E-09, 1.53963968623298E-11,-3.39165465615682E-11, JAI 
4 2.03253257423626E-12,-1.10679546097884E-14,-5.16169497785@8@E-15/JAL 
DATA AK2 / 2.74366150869598E-01, 5.39790969736903E-@3, JAL 
-1.57339220621199E-03, 4.2742752824875G@E-@4,-1.12124917399925E-04, JAI 
2.88763171318904E-O5,-7.36804225370554E-06, 1.872990209741624E-@6, JAI 
-4.75892793962291E-67, 1.21130416955909E-@7 ,-3.6924537427Q0614E-08, JAI 
7 .92454705282654E-09, -2.03902447167914E-09, 5.26863056595742E-16, JAIL 
-1.36704767639569E-19, 3.561410396137@8E-11 ,-9.3138829654843@E-12, JAI 
2.44464450473635E-12,-6.43846261999955E-13, 1.70106030559349E-13,JAL 
-4,50760104503281E-14, 1.19774799164811E-14,-3.19077040865066E-15/JAL 
DATA AK3 / 2.86271447340791E-@1,-1.78127642844379E-03, JAI 
1 4.03422579628999E-@5, -1.63249965269903E-06, 9.21181482476768E-@8, JAL 
2-6.52294330229155E-09, 5.47138464576546E-106,-5.2440825180026@E-11,JAT 
3 5.604779904117209E-12,-6.56375244639313E-13, 8.31285761966247E-14, JAL 
4-1,.12705134691063E-14, 1.62267976598129E-15,-2.46486324312426E-16/JAL 
DATA AJP / 7.78952966437581E-02,-1. 84356 3634568@1E-@1, JAL 
1 3.01412605216174E-@2, 3.053427242776O8E-062,-4 .95424702513079E-63, JAL 
2-1.72749552563952E-03, 2.4313763783919@E-@4, 5.064564777517682E-@5, JAIL 
3-6. 16316582695268E-06, -9.03986745510768E-07, 9.70243778355884E-8, JAL 
4 1.09639453305265E-08 ,-1.04716330588766E-09 , -9 .60359441344646E-11, JAI 
5 8.25358789454134E-12, 6.36123439018768E-13,-4.96629614116@15E-14, ae 
6-3.29816288929615E-15, 2.357982520311Q@4E- 16/ AL 
DATA AJN / 3.80497887617242E-@2,-2.45319541845546E- Pee 
1 1.65820623762696E-@1, 7.49330045818789E-02,-2.634762881Q06641E-@2, JAI 
2-5.92535597304981E-63, 1.44744409589804E-03, 2.18311831322215E-04, JAI 
3-4. 1066207 7680304E-05, -4.66874994171766E-G6, 7.1521880727716QE-07, JAL 
4 6.529647790854633E-08, -8 .442849027565946E-09 ,-6.44186158976978E~10, JAL 
5 7.20802286505285E-11, 4.72465431717846E-12,-4. 6602263254 7@45E-13, JAL 
6-2.67762710389189E-14, 2.36161316570019E-15/ JAL 
DATA A / 4.90275424742791E-@1, 1.57647277946204E-03, JAI 
1-9. 66195963140306E-05, 1.3591608026881L5E-67, 2.98157342654859E-@7, JAI 
2-1.86824767559979E-08, -1.03685737667141E-@9, 3.28660818434328E-10, JAI 
3-2.5709141063278@E-11,-2.32357655300677E-12, 9.57523279048255E-13, JAI 
4-1.20340828049719E-13,-2.9090771677@715E-15, 4.5565645458@149E-15, JAI 
5-9 .990038748190259E-16/ JAL 
DATA B / 2.785935528030679E-@1 ,-3.52915691882584E-063, JAL 
1-2. 31149677384994E-@5, 4.7131784226356@E-@6,-1.12415967931333E-@7, JAI 
2-2 .01003061184339E-08, 2.60948075362193E-@9 ,-3 .55098136161216E-11,JAIL 
3-3.50849978423875E-11, 5.83067187954202E-12,-2.04644828753326E-13, JAI 
4-1.10529179476742E-13, 2.87724778038775E-14,-2. 88295111009939E-15, JAL 


SDE WDY 


5-3.32656311696166E-16/ JAI 
DATA NLD, N2D, N3D, N4D /14,24,19,15/ JAI 
DATA MID, M2D, M3D, M4D /12,22,17,13/ JAI 
DATA DAK1 / 2.04567842307887E-@1 ,-6.61322739995664E-G2, JAL 


1-8. 49845800989287E-03, 3.12183491556289E-63 ,-2.70016489829432E-@4, JAI 
2-6. 35636298679387E-96, 3.02397712409509E-06 ,-2.18311195330088E-07, JAI 
3-5. 36194289332826E-106, 1.1369863562231GE-09,-7.43623834629073E-11, JAI 
4 4.28804176826891E-13, 2.238106925754539E-13,-1.39140135641182E-14/JAI 


511-P 9- 
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DATA DAK2 / 2.9333234388323@E-@1 ,-8.06196784743112E-03,JAI 850 
1 2.4254617233314GE-03,-6.82297548850235E-04, 1.85786427751181E-04,JAI 860 
2-4 .97457447684059E-05, 1.32096681239497E-05,-3.49528246444943E-06,JAI 870 
3 9.24362451078835E-07 ,-2.44732671521867E-07, 6.4930783764891GE-08,JAI 880 
4-1.72717621501538E-08, 4.60725763604656E-@9 ,-1.2324905529155QE-@9, JAI 890 
5 3.30620409488162E-10,-8.8925290997724G1E-11, 2.39773319878298E-11,JAI 940 
6-6.4801392115345@E-12, 1.75510132623731E-12,-4.76303829833637E-13,JAI 910 
7 1.2949824119081@E-13,-3.5267962221643@E-14, 9.62005151585923E-15,JAI 92¢ 
8-2.62786914342292E-15/ JAI 930 

DATA DAK3 / 2.84675828811349E-@1, 2.5307367261908GE-03,JAI 94¢ 
1-4.83481130337976E-05, 1.84967283946343E-06,-1.01418491178576E-@7,JAI 95¢ 
2 7.05925634457153E-09, -5.85325291400382E-10, 5.56357688831339E-11,JAI 96¢ 
3-5 .998890947795Q0GE-12, 6.88574353784436E-13,-8.68588256452194E-14, JAI 976 
4 1.17374762617213E-14,-1.68523146510923E-15, 2.55374773097056E-16/JAI 980 

DATA DAJP / 6.53219131311457E-2 ,-1.20262933688823E-01,JAI 99@ 
1 9.78610236263823E-03, 1.67948429230505E-02,-1.97146146182132E-03,JAI 1000 
2-8.455602959098867E-04, 9.42889620701976E-@5, 2.25827860945475E-O5,JAI 1410 
3-2. 29067870915987E-06, -3. 76343991136919E-@7, 3.45663933559565E-8,JAI 1920 
4 4.29611332003007E-09 , -3.58673691214989E-10,-3.57245881361895E-11,JAI 1636 
5 2.72696091066336E-12, 2.26120653095771E-13,-1.58763205238303E-14, JAI 1640 
6-1.12604374485125E-15, 7.31327529515367E-17/ JAI 1650 

DATA DAJN / 1.08594539632967E-62, 8.53313194857091E-92, JAI 1060 
1-3.15277068113058E-@1,-8.78420725294257E-@2, 5.53251906976048E-02,JAI 1670 
2 9.41674060503241E-G3, -3.32187026018996E-O3 ,-4.11157343156826E-04, JAI 1980 
3 1.01297326891346E-04, 9.87633682208396E-G6,-1.87312969812393E-G6,JAI 1690 
4-1.50798500131468E-07, 2.32687669525394E-68, 1.59599917419225E-09, JAI 11060 
5-2.07665922668385E-10,-1.24163356500302E-11, 1.39631765331643E-12,JAI 1110 
6 7.3940097115574QE-14,-7.3288747562750@E-15/ JAI 1120 

DATA DA / 4.916273211G46@1E-01, 3.11164936427489E-63, JAI 113@ 
1 8.23146762854681E-05,-4.61769776172142E-06 ,-6.13158880534626E-08,JAI 114¢ 
2 2.8729580465652GE-08,-1.81959715372117E-09 ,-1.44752826642035E-10,JAI 115@ 
3 4.53724043420422E-11,-3.99655065847223E-12,-3.24689119830323E-13,JAI 1160 
4 1.62098952568741E-13,-2.40765247974Q57E-14, 1.69384811284491E-16, JAI 1170 
5 8.17900786477396E-16/ JAI 1186 

DATA DB /-2.77571356944231E-@1, 4.4421283341992GE-03,JAI 1190 
1-8. 42328522196089E-05,-2.5804031841871GE-06, 3.42389726217621E-07, JAI 1200 
2-6 . 242868947097 76E-09, -2. 36377836844577E-69, 3.16991042656673E-10,JAI 1210 
3-4.40995691658191E-12,-5.18674221693575E-12, 9.64874015137622E-13, JAI 1220 
4-4.9019657660871GE-14,-1.77253430678112E-14, 5.55950610442662E-15, JAI 1230 


5-7.1179333757953GE-16/ JAI 1246 
IF (X.LT.@.) GO TO 9¢ JAI 125@ 
IF (C.GT.5.) GO TO 6¢ JAI 1266 
IF (X.GT.1.2) GO TO 3@ JAI 1276 
T = (X+X-1.2)*CON4 JAI 128¢ 
TT=T+T JAI 1296 
J =Nl JAI 1306 
Fl = AK1(J) JAI 131¢ 
F2 = @. JAI 132¢ 
DO 1@ I=1,Ml1 JAI 1330 

J=J-1 JAI 1346 
TEMP1 = Fl JAIL 1350 

Fl = TT*F1l - F2 + AK1(J) JAIL 1366 

F2 = TEMP1 JAI 1370 

16 CONTINUE JAI 1380 
AI = T*Fl - F2 + AKI(1) JAI 139¢ 

J = NID JAI 146¢ 
Fl = DAKI(J) JAI 1410 
F2 = @. JAI 1420 
DO 2@ I=1,M1D JAI 143¢ 
J=J-1 JAI 1440 
TEMP1 = Fl JAI 145¢ 

Fl = TT*Fl - F2 + DAK1(J) JAI 1466 

F2 = TEMP1 JAI 1470 

2@ CONTINUE JAI 1480 
DAL = -(T*F1-F2+DAK1 (1)) JAI 149¢ 
RETURN JAI 1500 
3@ CONTINUE JAI 151¢ 
T = (X+X-CON2)*CON3 JAI 152¢ 
TT =T+T JAIL 153@ 
J=N2. JAI 154@ 

Fl = AK2(J) JAI 155@ 

F2 = @. JAI 1560 
DO 4@ I=1,M2 JAI 157@ 
J=J-1 JAI 1580 
TEMP1 = Fl JAI 159¢ 


Fl = TT*Fl - F2 + AK2(J) JAI 1600 


COLLECTED ALGORITHMS (cont.) 


F2 = TEMP1L 


4@ CONTINUE 


5¢ 


60 


70 


8¢ 


90 


100 


11¢ 


RTRX = SQRT (RX) 
EC = EXP(-C) 
AI = EC*(T*F1-F2+AK2(1)) /RTRX 
J = N2D 
Fl = DAK2(J) 
F2 = @. 
DO 5@ I=1,M2D 
Bae aes | 
TEMP1 = Fl 
Fl = TT*F1l - F2 + DAK2(J) 
F2 = TEMP1 
CONTINUE 
DAIL = -EC* (T*F1-F2+DAK2 (1) )*RTRX 
RETURN 
CONTINUE 
T= 1¢./C - 1. 
TT =T+T 


is] 
— 
lou 

> 
wR 
(os) 
o~ 
qq 
we 


DO 7@ I=1,M1 
J=x«J-1 
TEMP] = Fl 
Fl = TT*F1 - F2 + AK3(J) 
F2 = TEMP] 
CONTINUE 
RTRX = SQRT(RX) 
EC = EXP(-C) 
AL = EC* (T*F1-F2+AK3 (1) ) /RTRX 
J = NID 
Fl = DAK3(J) 
F2 = @. 
DO 8@ I=1,MI1D 
J=eJJ-1 
TEMP1 = Fl 
Fl = TT*F1l - F2 + DAK3(J) 
F2 = TEMPL 
CONTINUE 
DAI = -RTRX*EC* (T*F1-F2+DAK3(1)) 
RETURN 
CONTINUE 
IF (C.GT.5.) GO TO 12¢ 
T= .4*4C - 1. 


AJP (J) 
AJN (J) 
0. 


ics} 
bo 
tun u 


¢. 
DO 1¢@ I=1,M3 
J=eJ-1 
TEMP1 = Fl 


TT*Fl - F2 + AJP(CJ) 
- E2 + AJN(J) 


hy 

N 
fon nt wl 

ta 

ica] 

& 

rd 


E2 = TEMP2 
CONTINUE 
AL = (TXE1-E2+AJN(1)) - X*(T*F1-F2+A3P(1)) 
J = N3D 
DAJP (J) 
DAIN(J) 
@. 


hy 
ho 
onou od 


Q. 
DO 11¢ I=1,M3D 
J=J-1 
TEMP1 = Fl 
TEMP2 = El 
= TTAF] - F2 + DAJP(J) 
El = TT*E] - E2 + DAJN(J) 
= TEMP1 
E2 = TEMP2 
CONTINUE 


DAI = X*X*(T*F1-F2+DAJP(1)) + (T*E1-E2+DAJN(1)) 
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COLLECTED ALGORITHMS (cont.) 
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120 
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RETURN 
CONTINUE 

T= 19./c - 1. 
1T=T+T 

J =N4 

A(J) 
B(J) 

d. 

d. 

3@ I=1,M4 
J=J-1 


is] 
bho 
m—- Ho On tll 


TT*Fl - F2 + A(J) 
TT*EL - E2 + B(J) 
TEMP 1 

TEMP 2 

CONTINUE 

TEMP] = T*F1 - F2 + A(1) 
TEMP2 = T*El - E2 + B(1) 
RTRX = SQRT(RX) 

CV = C - FPI12 

CCV = COS(CV) 

SCV = SIN(CV) 


yj 
be 
ot oa 


AI = (TEMP1*CCV-TEMP2*SCV) /RTRX 


J = N4D 
Fl = DA(J) 
= DB(J) 
= @. 
E2 = @. 
14@ I=1,M4D 
J=J-1 


TT*Fl - F2 + DA(CJ) 
- E2 + DB(J) 


ie 3] 
| 
i i oii 
ae} 
=| 
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ei 
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CONTINUE 

TEMP] = T*F1 - F2 + DA(1) 
TEMP2 = T*E1 - E2 + DB(1) 
El CCV*CON5 + .5*SCV 
E2 SCV*CONS - .5*CCV 


DAL = (TEMP1*E1-TEMP2*E2)*RTRX 


RETURN 
END 
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COLLECTED ALGORITHMS (cont.) 


C J/SUB(ALPHA+K-1)/(X), K=1,...,N FOR NON-NEGATIVE ALPHA AND X. JBE 
C A COMBINATION OF THE POWER SERIES, THE ASYMPTOTIC EXPANSION JBE 
c FOR X TO INFINITY AND THE UNIFORM ASYMPTOTIC EXPANSION FOR JBE 
G NU TO INFINITY ARE APPLIED OVER SUBDIVISIONS OF THE (NU,X) JBE 
GC PLANE. FOR VALUES OF (NU,X) NOT COVERED BY ONE OF THESE JBE 
Cc FORMULAE, THE ORDER IS INCREMENTED OR DECREMENTED BY INTEGER JBE 
C VALUES INTO A REGION WHERE ONE OF THE FORMULAE APPLY. BACKWARDJBE 
Cc RECURSION IS APPLIED TO REDUCE ORDERS BY INTEGER VALUES EXCEPTJBE 
Cc WHERE THE ENTIRE SEQUENCE LIES IN THE OSCILLATORY REGION. IN JBE 
Cc THIS CASE FORWARD RECURSION IS STABLE AND VALUES FROM THE JBE 
Cc ASYMPTOTIC EXPANSION FOR X TO INFINITY START THE RECURSION JBE 
Cc WHEN IT IS EFFICIENT TO DO SO. LEADING TERMS OF THE SERIES ANDJBE 
C UNIFORM EXPANSION ARE TESTED FOR UNDERFLOW. IF A SEQUENCE IS JBE 
G REQUESTED AND THE LAST MEMBER WOULD UNDERFLOW, THE RESULT IS JBE 
G SET TO ZERO AND THE NEXT LOWER ORDER TRIED, ETC., UNTIL A JBE 
C MEMBER COMES ON SCALE OR ALL MEMBERS ARE SET TO ZERO. OVERFLOWJBE 
C CANNOT OCCUR. JBESS CALLS SUBROUTINE JAIRY AND FUNCTION GAMLN.JBE 
Cc JBE 
Cc DESCRIPTION OF ARGUMENTS JBE 
Cc JBE 
C INPUT JBE 
C ALPHA — ORDER OF FIRST MEMBER OF THE SEQUENCE, ALPHA.GE.@ JBE 
C N - NUMBER OF MEMBERS IN THE SEQUENCE, N.GE.1 JBE 
C X - X.GE.@ JBE 
Cc JBE 
C OUTPUT JBE 
GC Y - A VECTOR WHOSE FIRST N COMPONENTS CONTAIN JBE 
Cc VALUES FOR J/SUB(ALPHA+K-1)/(X), K=1,...,N JBE 
Cc JBE 
G ERROR CONDITIONS JBE 
Cc IMPROPER INPUT ARGUMENTS - A FATAL ERROR JBE 
C UNDERFLOW —- A NON-FATAL ERROR JBE 
Cc JBE 
DOUBLE PRECISION DX, TRX, DIM, DFN JBE 
DIMENSION Y¥(1) JBE 
DIMENSION C(11,10), ALFA(26,4), BETA(26,5) JBE 
DIMENSION C1(11,8), C2(11,2), ALFA1(26,2), ALFA2(26,2) JBE 
DIMENSION BETAI1 (26,2), BETA2(26,2), BETA3(26,1) JBE 
DIMENSION GAMA(26), TEMP(3), KMAX(5), AR(8), BR(16), UPOL(1@) JBE 
DIMENSION FNULIM(2), PP(4) JBE 
DIMENSION CR(1@6), DR(10) JBE 
EQUIVALENCE (C(1,1),C1(1,1)) JBE 
EQUIVALENCE (C(1,9),C2(1,1)) JBE 
EQUIVALENCE (ALFA(1,1),ALFA1(1,1)) JBE 
EQUIVALENCE (ALFA(1,3),ALFA2(1,1)) JBE 
EQUIVALENCE (BETA(1,1),BETA1(1,1)) JBE 
EQUIVALENCE (BETA(1,3),BETA2(1,1)) JBE 
EQUIVALENCE (BETA(1,5) ,BETA3(1,1)) JBE 

DATA ELIML,ELIM2,TOL / 667. ri 644. 1.E-15 / JBE 

re JBE 
DATA PP / 8.72909153935547E+0O, 2.65693932265030E-O1 , JBE 

1 1.24578576865586E-@1, 7.76133747430388E-@4/ JBE 

C TOLS=LN(1.E-3) JBE 
DATA TOLS /-6.90775527898214E+00/ JBE 

DATA CON1,CON2,CON548/ 6.66666666666667E-@1, 3.33333333333333E-@1,JBE 


1 1.04166666666667E-@1 


/ 


DATA RTWO,PDF,RTTP,PIDT 


/ 
» 7.97884560802865E-61, 


JBE 


-34839972492648E+00, JBE 


1 7.85398163397448E-@1 1.5767963267949GE+G6@/ JBE 
DATA FNULIM 100. “ 60. / JBE 
C CE=-ALOG(TOL) , TCE=-0.75*ALOG (TOL) JBE 
DATA CE , TCE / 3.453877639491G7E+O1, 2.5904682296183GE+01/JBE 
DATA INLIM / 15¢ j JBE 
DATA AR / 8.35503472222222E-02, 1.28226574556327E-@1,JBE 
1 2.91849902646414@E-@1, 8.81627267443758E-@1, 3.32140828186277E+00, JBE 
2 1.49957629868626EtG1, 7.8923G13@115865E+01, 4.74451538868264E+G2/JBE 


DATA BR 


3-4 .92355370523671E+O2,-3.31621856854797E+O3/ 


/-1.45833333333333E-@1, -9 
1-1.43312653915895E-@1 , -3.17227202678414E-@1 ,-9 
2-3 511263040826 35E+00, -1.57272636203680E+O1 , -8 


-87413194444444E-62, JBE 
-4242914795712QE-O1, JBE 
.22814390971859E+G1, JBE 


JBE 


DATA Cl /-2.08333333333333E-01, 1.2560000000000GE-@1 , JBE 
1 9(@.) , 3.34201388888889E-61,-4.01041666666667E-61, JBE 
2 7.0312590GGOOOOOE-G2 , 8(@.) »-1.02581259645062E+00, JBE 
3 1.84646267361111E+$G, -8.9121693750GGQGE-G1, 7.3242187500000OE-G2, JBE 
4 7(@.) » 4669584423426 25EtOO, -1.1267002616223GE+O1, JBE 
5 8.78912353515625E+0@, -2.3640869140625GE+0G, 1.12152099669375E-@1,JBE 
6 6(@.) 5-7 2.82120725582G02E+91, 8.46362176746007E+O1,JBE 
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COLLECTED ALGORITHMS (cont.) 


Se ee, ee 


re ee 


| 
Nh ~BD 


a 


.181824154324Q@GE+01, 4.25349987453885E+01 ,-7. 36879435947963E+00, JBE 
.27108001708984E-@1, 5(@.) » 2.12570136039217E+02, JBE 
-65252468141182E+92, 1.6599904525280GE+03,-6 .99579627376133E+G2, JBE 
. 1819951174421 2E+O2,-2.64914304869516E+O1, 5.72501426974731E-@1,JBE 
4(@.) 571.91945766231841E+03, 8.¢6172218173731E+03, JBE 
-35865500064341E+04, 1.16553933368645E+04,-5 .3056469786134GEt+03,JBE 
- 20099291321635E+03,-1.08090919788395E+02, 1.72772750258446E+00, JBE 
3(@.) » 2.02042913309661E+04,-9.69805983886375E+04, JBE 
925479001232532E+05 ,-2.03406177280416E+O5, 1.22206464983017E+05,JBE 
11926549688976E+04, 7.10951436248936E+063 ,-4.93915304773088E+02, JBE 
07404206127348E+00, 2(@.) / "SBE 
TA C2 /-2.429191879@@551E+O5, 1.31176361466298E+@6 , JBE 
9980159185381 1E+6, 3.7632712976564GEt+06,-2.&1356322658653E+06, JBE 


49983048181121E+03, 2.43805296995561E+@1, 1(@.) » JBE 
28446985 307204E+06 ,-1.97068191184322E+G7, 5.0:9526024926646E+07 , JBE 
41951482115327E+07, 6.6344512274729GE+07 ,-3.75671766607634E+@7 , JBE 
3288767166421 8E+@7 ,-2.78561812808645E+6, 3.08186404612662E+05,JBE 
388608975371 7GE+04, 1.10617146269247E+$2/ JBE 


1. 
~-4, 
6. 
DA 
~2, 
1.26836527332162E+96,-3.31645172484564E+05, 4.52187689813627E+04, JBE 
-2. 
3. 
-7. 
1. 
-1. 
A 


DATA ALFAL 14 444444444 44444E-03 ,-9 .22677922077922E-O4 , JBE 


ale ee ees Or CANAU Ewe 


Geet ee ee Oy pe ee 


1 
2 
3 
4 
5 
6 
7 
8 
9- 
A- 
B- 
C- 
D 
E 
F 
G 


-84892884892885E-05, 1.6592768783245QE-04, 2.46691372741793E-04 , JBE 
-65995589346255E-04, 2.61824297G615G1E-04, 2.48730437344656E-04, JBE 
-32721040983232E-04, 2.16362485712365E-04, 2.90738858762752E-04, JBE 
-86267636637545E-04, 1.73060775917876E-04, 1.61091705929016E-04, JBE 
-502747741699@8E-04, 1.4056349739127GE-04, 1.51668816545923E-04, JBE 


-03772416422993E-04, 9.82626078369363E-65, 9.52120517249503E-05, JBE 
-85719852478712E-65, 8.4296310657157@QE-05, 8.034975484067791E-O5, JBE 
-93735541354589E-@04, 2.32241745182922E-04 ,-1.41986273556691E-@5, JBE 
-16444931672049E-O4 , -1 . 5080355805 3649E-04 ,-1 .55121924918096E-04 , JBE 
-46809756646466E-4 , -1.33815503867491E-04,-1.19744975684254E-04 , JBE 


-8 
2 
2 
1 
1 
1.23667445598253E-04, 1.16405271474738E-04, 1.09798298372713E-04, JBE 
1 
8 
6 
= 
-1 
-1 


-7 
-5 
3 
-2, 
~1. 
DA 


Jie 
1, 
1. 
6. 
2. 
7. 
-2 
-8 
3 
-2 
-2 
-1 
-1 
3. 
5. 
6. 
5. 
DA 
2. 
9. 
4.6 
Ze 
1. 
1. 
l. 
8. 
1. 
2. 
5. 
2. 
1. 
2. 
2. 


2. 


-06184319207974E-04 , -9.37699549891194E-65 ,-8.269239045588193E-05 , JBE 
«29374348155221E-05,-6.44042357721916E-05,-5.69611566009369E-@5, JBE 
-04731644363562E-@5 ,-4 .48134868698883E-05 ,-3.98688727717599E-@5, JBE 
- 5540053297204 2E-@5 ,-3.17414256699022E-65 ,-2 .83996793994175E-05, JBE 
5452272063487 1E-O5,-2.28459297164725E-@5 ,-2.05352753196481E-05 , JBE 
84816217627666E-05 ,-1.66519339021394E-05/ JBE 


TA ALFA2 /-3.54211971457744E-@4 ,-1.56161263945159E-04, JBE 


04465503594936E-05, 1.30198655773243E-04, 1.67471106699712E-04, JBE 
70222587683593E-04, 1.56501427608595E-04, 1.36339170977445E-04, JBE 
14886692629825E-@4, 9.45869993034688E-05, 7.6449841925¢898E-05, JBE 
67570334965197E-05, 4.743942992905Q9E-65, 3.62757512005344E-@5 , JBE 
69939714979225E-05, 1.93210938247939E-@5, 1.30056674793963E-@5, JBE 
82620866744497E-06, 3.59257485819352E-@6, 1.44646049814252E-67, JBE 
-65396769697939E-06, -4.91346867698486E-G6 ,-6 . 727392969091248E-06 , JBE 
-17269379678658E-06, -9. 31304715693561E-06,-1.02011418798016E-@5, JBE 
-78194199201773E-04, 2.02471952761816E-04,-6.37938596318862E-@5, JBE 
+ 385982306903006E-04 , -3.10916256027362E-04 ,-3.13680115247576E-04, JBE 
- 78950273791323E-04 ,-2.28564082619141E-04 ,-1.7524528634684 7E-04, JBE 
+ 2554406 36606 9GE-O4 , -8 .22982872826208E-O5 ,-4 .62860730588116E-05, JBE 
-72334362366962E-05, 5.60690482304602E-06, 2.31395443148287E-O5,JBE 
62642745856794E-05, 4.58006124499189E-65, 5.24595294959114E-05, JBE 
68396268545815E-05, 5.94349829393104E-65, 6.96478527578422E-05, JBE 
08023907788436E-05, 6.0157789453946QE-05, 5.89199657344698E-O5, JBE 
72515823777593E-05, 5.52804375585853E-05/ JBE 
TA BETAL / 1.79988721413553E-@2, 5.59964911964388E-63, JBE 
88501402231133E-03, 1.80096606761054E-03, 1.24753110589199E-93, JBE 
22878876572938E-04, 7.14430421727287E-04, 5.717872817897@5E-04, JBE 
69431007696482E-04, 3.93232835462917E-04, 3.34818889318298E-04, JBE 
88952148495752E-04, 2.52211615549573E-@4, 2.222865806798883E-04, JBE 
975418389033063E-04, 1.76836855019718E-04, 1.59316899661821E-04, JBE 
44347930197334E-04, 1.31448068119965E-04, 1.20245444949303E-04, JBE 
16449144594599E-04, 1.01828776740567E-04, 9.41998224204238E-65, JBE 
74130545753834E-65, 8.134662621628G1E-05, 7.59062269646219E-@5,JBE 
49282953213429E-03, -8. 78204769546 389E-O4,-5 .2916549572035E-04, JBE 
94822138512746E-04 ,-1.75463996976783E-04 ,-1 .04908550460816E-04, JBE 
96141953046458E-05 ,-3.12038929676098E-@5 ,-1 .26689735980230E-65 , JBE 
4289269857573QE-07, 8.05996165414274E-6, 1. 36507009262147E-5, JBE 
73964125472926E-@5, 1.98672978842134E-05, 2.14463263799823E-05, JBE 
23954659232457E-05, 2.28967783814713E-95, 2.36785389811178E-@5, JBE 
3032197608G9@9E-G5, 2.28236073720349E-65, 2.25005881165292E-05, JBE 
29981015361991E-@5, 2.164184274481Q04E-@5, 2.11507649256221E-05, JBE 


H 2.06388749782171E-05, 2.01165241997082E-05/ JBE 
DATA BETA2 / 5.52213676721293E-04, 4.47932581552385E-04, JBE 
1 2.79520653992021E-04, 1.52468156198447E-04, 6.93271105657044E-05, JBE 
2 1.76258683669991E-05,-1.35744996343269E-05 ,-3.17972413350427E-O5 , JBE 


1650 
1660 
1670 
1686 
1690 
1100 
1110 
1126 
113¢ 
1149 
1150 
1160 
1170 
1180 
1190 
1200 
1210 
1226 
1230 
124¢ 
1250 
1260 
1270 
1280 
1290 
1300 
131¢ 
1320 
1330 
1340 
1350 
136¢ 
1370 
138¢ 
1390 
1460 
141¢ 
1420 
1439 
1440 
1450 
1460 
147¢ 
1489 
1490 
150¢ 
1510 
1520 
1530 
154@ 
155@ 
1560 
1570 
1580 
1590 
1600 
1610 
162¢ 
163@ 
164¢ 
1650 
1660 
1670 
1680 
1690 
1706 
171¢ 
172¢ 
173@ 
1740 
1750 
1760 
1770 
1780 
1790 
1800 
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COLLECTED ALGORITHMS (cont.) 


-97092684075675E-65, 


3- 
he 
5- 
6- 
7- 
8- 
9- 
A- 
B 
C 1.13103642108481E-@4, 
D 
E 
F 
a 
H 


1.97893056664022E-65, 
DATA BETA3 


1.43138236768272E-@4, 
1.08651634848774E-04, 
-29298396593364E-65, 8.46293133016G9GE-05, 7.52727991349134E-05, JBE 
-69632521975731E-65, 5.92564547323195E-05, 5.22169308826976E-@5 , JBE 
-58539485165361E-05, 4.01445513891487E-05, 3.50481730031328E-065,JBE 
-95157995034347E-05, 2.64956119950516E-O5, 2.29363633696998E-@5, JBE 
1.76091984636413E-65/ 
/ 7.36465810572578E-04, 8.72796805146194E-04, JBE 


4,18861861696693E-65,-4.69004889379141E-05,-4.87665447413787E-@5, JBE 
4 .87010031186735E-05 ,-4. 7475562089008 7E-O5 , -4 .55813058138628E-65, JBE 
4. 33309644511266E-65,-4 .6923619315775GE-65 ,-3 .84822638603221E-65,JBE 
3.60857167535411E-@5,-3.37793306123367E-@5 ,-3.1588856077211GE-@5 , JBE 
2.95269561750807E-05 ,-2.75978914828336E-@5 ,-2.58006174666884E-65 , JBE 
-2.4139835676128@E-65,—2 .25823509518346E-065 ,-2.11479656768913E-065,JBE 
4.7461779655996@E-04,-4.77864567147321E-04 ,-3.20390228067038E-@4 , JBE 
-1.61105016119962E-04,-4.25778101285435E-@5, 3.44571294294968E-@5, JBE 
7 
1 
9 
6 
4 
3 


1.12466775262204E-@4 , JBE 
1.01437951597662E-04, JBE 


JBE 


1 6.22614862573135E-04, 2.85998154194304E-04, 3.84737672879366E-06, JBE 
2-1.879960036 3697 2E-04 ,-2.97603646594555E-04 ,-3 .45998126832656E-@4, JBE 
3-3 .53382476916038E-4, -3.35715635775049E-O4 ,-3 .9432112478904GE-04, JBE 
4~2.66722723647613E-04,-2.2765421412282GE-G4 ,-1.89922611854562E-64, JBE 
5-1.55058918599694E-04 , -1.23778246761874E-O4, ~9 .62926147717644E-O5, JBE 
6-7 .25178327714425E-05, -5 .22070628895634E-05 ,-3 .50347750511901E-@5, JBE 


7-2.06489761035552E-65,- 
8 9.16426474122779E-G6, 
DATA GAMA / 
1 1.54799300415656E-@1, 


8.70106696849767E-06, 
1.56477785428873E-05, 
6 .29960524947437E-O1, 
1.10713062416159E-@1, 


1.136986866751Q0GE-@6, JBE 
2 .08223629482467E-65/JBE 
2.51984209978975E-O1 , JBE 
8 .57309395527395E-@2, JBE 


2 6.97161316958684E-62, 5.86085671893714E-02, 5.04698873536311E-@2,JBE 
3 4.42600580689155E-02, 3.9372666154351GE-@2, 3.54283195924455E-02, JBE 
4 3.21818857502098E-02, 2.94646240791158E-62, 2.71581677112934E-02,JBE 
5 2.51768272973862E-@2, 2.34570755306079E-02, 2.19568390134907E-62, JBE 


6 2.06210828235646E-@2, 
7 1.74293213231963E-@2, 
8 1.56729561494696E-62, 


C TEST INPUT ARGUMENTS 


KT = 1 

IF (N-1) 71¢, 10, 20 
16 KT = 2 
20 NN = N 


IF (X) 726, 36, 8@ 
30 IF (ALPHA) 706¢, 4@, 50 
46 Y(1) = 

IF (N.EQ.1) RETURN 

Il = 

GO- TO 60 
5@ Il = 1 
66 DO 7¢ I=I1,N 

Y(I) = @. 

7@ CONTINUE 

RETURN 
8@ CONTINUE 

IF (ALPHA.LT.@.) GO TO 


DFN = 

FNU = DEN 

X02 = X*.5 
SXO2 = X02*xX02 


1.94388249897881E-@2, 
1.65685837786612E-02, 
1.44193250839955E-@2, 


700 


DBLE(FLOAT(N)) + DBLE(ALPHA) - 1.D+@ 


C DECISION TREE FOR REGION WHERE SERIES, ASYMPTOTIC EXPANSION FOR X 
C TO INFINITY AND ASYMPTOTIC EXPANSION FOR NU TO INFINITY ARE 


C APPLIED. 


IF (SX02.LE.(FNU+1.)) GO TO 9¢ 


TA = AMAX1(2@.,FNU) 

IF (X.GT.TA) GO TO 126 
IF (X.GT.12.) GO TO 110 
XO2L = ALOG(X02) 

NS = SxX02 - FNU 


GO TO 100 
9@ FN = FNU 
FNP1 = FN + l. 
X0O2L = ALOG(X02) 
IS = KT 
IF (X.LE.@.5) GO TO 330 
NS = @ 
10@ DFN = DFN + DBLE(FLOAT(NS)) 
FN = DFN 
FNP1 = FN + l. 
IS = KT 


IF (N-14NS.GT.0) IS = 3 


1 .83819633800683E-02, JBE 
1.57865285987918E-@2, JBE 
1.381848065735342E-@2/JIBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 


181¢ 
182¢ 
183@ 
1840 
185¢@ 
1860 
1870 
188¢ 
1890 
1990 
1910 
192¢ 
1930 
194¢ 
1950 
196¢ 
1970 
198@ 
1990 
2600 
2010 
2026 
2030 
2046 
2050 
2060 
2070 
208¢ 
2690 
2100 
2110 
2120 
2136 
214¢ 
2150 
2160 
217¢ 
2186 
2190 
2200 
2210 
2226 
2230 
2240 
2250 
2260 
2270 
2286 
2290 
2300 
2310 
2320 
233 
2346 
235¢ 
2360 
2379 
2380 
2390 
2400 
2410 
2420 
2430 
2440 
2456 
2460 
2470 
2480 
2490 
2500 
2510 
2520 
253¢ 
2540 
255¢ 
2560 
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GO TO 33 
11@ NS = AMAX1(36.-FNU,@.) 
DFN = DFN + DBLE(FLOAT (NS) ) 


FN = DFN 
IS = KT 
IF (N-1+NS.GT.@) IS = 3 
GO TO 13¢ 
12@ CONTINUE 
RTX = SQRT(X) 
TAU = RTWO*RTX 


TA = TAU + FNULIM(KT) 
LF (FNU.LE.TA) GO TO 48¢ 
FN = FNU 
IS = kT 
C UNIFORM ASYMPTOTIC EXPANSION FOR NU TO INFINITY 
130 CONTINUE 
XX = X/FN 
W2 = 1. — XX*XX 
ABW2 = ABS(W2) 
RA = SQRT(ABW2) 
IF (ABW2.GT.@.2775) GO TO 220 
CASES NEAR X=FN, ABS(1.-(X/FN)**2) .LE.@.2775 
COEFFICIENTS OF ASYMPTOTIC EXPANSION BY SERIES 


AAA 


SA = @. 
IF (ABW2.EQ.@.) GO TO 14¢ 
SA = TOLS/ALOG(ABW2) 
140 SB = SA 
DO 15¢@ I=1,5 
KMAX(I) = AMAX1(SA,2.) 
SA = SA + SB 
15@ CONTINUE 
KB = KMAX(5) 
KLAST = KB - 1 
SA = GAMA(KB) 
DO 16@ K=1,KLAST 
KB = KB - 1 
SA = SA*W2 + GAMA(KB) 
16@ CONTINUE 
Z = W2*SA 
AZ = ABS(Z) 
RTZ = SQRT(AZ) 
FNL3 = FN**CON2 
RTARY = RTZ*FN13 
ARY = -RTARY*RTARY 
AZ32 = AZ*RTZ*CON1 
ACZ = FN*AZ32 
IF (Z.LE.%.) GO TO 170 


C TEST FOR UNDERFLOW, 1.E-28@=EXP(-644.), ONE WORD LENGTH 


C UP FROM UNDERFLOW LIMIT OF CDC 660¢ 
IF (ACZ.GT.ELIM2) GO TO 38@ 
ARY = -ARY 
17@ PHI = SQRT(SQRT(SA+SA+SA+SA) ) 
C B(ZETA) FOR S=@ 
KB = KMAX(5) 
KLAST = KB - 1 
SB = BETA(KB,1) 
DO 18@ K=1,KLAST 
KB = KB - 1 
SB = SB*W2 + BETA(KB,1) 
18@ CONTINUE 


KSP1 = 1 

FN2 = FN*FN 

RFN2 = 1./FN2 

RDEN = 1. 

ASUM = 1. 

RELB = TOL*ABS(SB) 

BSUM = SB 

DO 26¢ KS=1,4 
KSP1 = KSP1 + 1 


RDEN = RDEN*RFN2 
C A(ZETA) AND B(ZETA) FOR S=1,2,3,4 
KB = KMAX(5-KS) 
KLAST = KB - 1 
SA = ALFA(KB,KS) 


ZETA AND TRUNCATION FOR A(ZETA) AND B(ZETA) SERIES 
KMAX IS TRUNCATION INDEX FOR A(ZETA) AND B(ZETA) SERIES=MAX(2,SA) 


JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 


2570 
2580 
2596 
2600 
2610 
2620 
2630 
2640 
265@ 
2660 
2670 
2680 
2690 
2760 
2710 
2720 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
2800 
2810 
2820 
2830 
2846 
285¢ 
2860 
2876 
2880 
2890 
2900 
2910 
292¢ 
2930 
2940 
2950 
2960 
2970 
2980 
2990 
3000 
3010 
3020 
3030 
3040 
3050 
3060 
30670 
3080 
36990 
31060 
3110 
3126 
3130 
3146 
3150 
3160 
3170 
318¢ 
3199 
3200 
321¢ 
3220 
3230 
3246 
3250 
3260 
3270 
3280 
3290 
3300 
3310 
3320 
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19¢ 


200 
216 


220 


SB = BETA(KB,KSP1) 
DO 199 K=1,KLAST 


KB = KB - 1 

SA = SA*W2 + ALFA(KB,KS) 

SB = SB*W2 + BETA(KB,KSP1) 
CONTINUE 


TA = SA*RDEN 
TB = SB*RDEN 
ASUM = ASUM + TA 
BSUM = BSUM + TB 
IF (ABS(TA).LE.TOL .AND. ABS(TB).LE.RELB) GO TO 210 
CONTINUE 
CONTINUE 
BSUM = BSUM/(FN*FN13) 
GO TO 36¢ 
CONTINUE 
TAU = 1./RA 
T2 = 1./Ww2 
IF (W2.GE.@.) GO TO 23¢ 


C CASES FOR (X/FN) .GT.SQRT (1.2775) 


239 


AZ32 = ABS (RA-ATAN (RA) ) 
ACZ = AZ32*FN 


CZ = -ACZ 
Z32 = 1.5*AZ32 
RTZ = Z32**CON2 


FN13 = FN**CON2 
RTARY = RIZ*FN13 
ARY = -RTARY*RTARY 
GO TO 24¢@ 

CONTINUE 


C CASES FOR (X/FN) .LT.SQRT(@.7225) 


AZ32 = ABS (ALOG((1.+RA) /XX)-RA) 


C TEST FOR UNDERFLOW, 1.E-28@ = EXP(-644.), ONE WORD LENGTH 
C UP FROM UNDERFLOW LIMIT OF CDC 660¢ 


246 


250 


26¢ 


ACZ = AZ32*FN 

CZ = ACZ 

IF (ACZ.GT.ELIM2) GO TO 38¢ 
Z32 = 1.5*AZ32 

RTZ = Z32**CON2 

FN13 = FN**CON2 

RTARY = RTZ*FNL3 

ARY = RTARY*RTARY 
CONTINUE 

PHI = SQRT((RTZ+RTZ)*TAU) 
T 


= 1. 


ASUM le 
TFN = TAU/FN 
UPOL(1) = 1. 


UPOL(2) = (C(1,1)*T2+C(2,1))*TEFN 

RCZ = CONL/CZ 

CRZ32 = CON548*RCZ 

BSUM = UPOL(2) + CRZ32 

RELB = TOL*ABS (BSUM) 
TFN 
i) 


LRP 1 


Sl = C(1,K) 
DO 250 J=2,KP1 
Sl = S1*T2 + C(J,K) 
CONTINUE 
AP = AP*TFN 
UPOL(KP1) = AP*S1 
CR(KS) = BR(KS)*RZDEN 
RZDEN = RZDEN*RCZ 
DR(KS) = AR(KS)*RZDEN 
CONTINUE 
SUMA = UPOL(LRP1) 
SUMB = UPOL(LR+2) + UPOL(LRP1)*CRZ32 
JU = LRP1 
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JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
JBE 
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3330 
3340 
335@ 
3360 
3370 
3380 
3390 
3400 
3410 
3426 
3436 
3440 
3456 
3460 
3470 
3480 
3490 
3500 
3510 
3520 
3530 
3540 
3550 
3560 
3570 
3580 
3590 
3600 
3610 
3620 
363¢ 
3640 
365¢ 
3660 
3670 
3680 
3696 
3700 
371¢ 
3726 
373¢ 
3740 
375 
3760 
3770 
3780 
3796 
3800 
3810 
3826 
3830 
3840 
3850 
3860 
3870 
3880 
389¢ 
3900 
3910 
3926 
3936 
3946 
3956 
3960 
3970 
3980 
3996 
4900 
461¢ 
4620 
4630 
4640 
4050 
4660 
4070 
40680 
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DO 27@ JR=1,LR JBE 469¢ 

JU = jJU-1 JBE 4106 

SUMA = SUMA + CR(JR)*UPOL(JU) JBE 41106 

SUMB = SUMB + DR(JR)*UPOL(JU) JBE 4120 

276 CONTINUE JBE 4130 
TB = -TB JBE 414¢ 

IF (W2.GT.@.) TB = ABS(TB) JBE 415¢ 

ASUM = ASUM + SUMA*TB JBE 4160 

BSUM = BSUM + SUMB*TB JBE 4170 

IF (ABS(SUMA).LE.TOL .AND. ABS(SUMB).LE.RELB) GO TO 29¢ JBE 4180 

289 CONTINUE JBE 4190 
29% TB = RTARY JBE 4200 
IF (W2.GT.@.) TB = -TB JBE 4210 
BSUM = BSUM/TB JBE 4220 

300 CONTINUE JBE 423¢ 
CALL JAIRY(ARY, RTARY, ACZ, AI, DAI) JBE 4240 
TEMP (IS) = PHI*(AI*ASUM+DAI*BSUM) /FN13 JBE 4250 

GO TO (320, 450, 616), IS JBE 4266 

31@ TEMP(1) = TEMP (3) JBE 4276 
KT = 1 JBE 4280 

32@ IS = 2 JBE 4290 
DFN = DFN - 1.D+@ JBE 4300 

FN = DFN JBE 4316 

GO TO 13¢ JBE 4320 

C SERIES FOR (X/2)**2.LE.NU+1 JBE 433¢ 
33@ CONTINUE JBE 434¢ 
GLN = GAMLN(FNP1) JBE 4350 
ARG = FN*XO2L - GLN JBE 436¢ 

IF (ARG.LT.-ELIM1) GO TO 4¢¢ JBE 4376 
EARG = EXP (ARG) JBE 4380 

34@ CONTINUE JBE 4390 
S=l. JBE 4400 

AK = 3. JBE 4410 

T = 1 JBE 4420 
T=1l. JBE 4430 

Sl = FN JBE 4446 

DO 350 K=1,17 JBE 4450 

S2 = 12+ Sl JBE 4460 

T = ~T*Sx02/S2 JBE 4470 
S=S+T JBE 448¢@ 

IF (ABS(T).LT.TOL) GO TO 36¢@ JBE 4499 

T2 = T2 + AK JBE 450¢ 

AK = AK + 2, JBE 4510 

Sl = $1 + FN JBE 4520 

35@ CONTINUE JBE 4530 
360 CONTINUE JBE 45406 
TEMP (IS) = S*EARG JBE 455¢ 

GO TO (379, 45@, 606), IS JBE 4560 

37@ EARG = EARG*FN/X02 JBE 4576 
DFN = DFN - 1.D+@ JBE 458@ 

FN = DFN JBE 459¢ 

Is = 2 JBE 4606¢ 

GO TO 34¢ JBE 4616 

C SET UNDERFLOW VALUE AND UPDATE PARAMETERS JBE 4626 
380 Y(NN) = @. JBE 463¢ 
NN = NN - 1 JBE 464@ 
DFN = DFN - 1.D+@ JBE 4650 

FN = DFN JBE 4660 

IF (NN-1) 4446, 396, 13@ JBE 4670 

39@ KT = 2 JBE 468¢ 
IS = 2 JBE 4690 

GO TO 13¢ JBE 4760 

40@ Y(NN) = @. JBE 47106 
NN = NN - 1 JBE 4726 
FNP1 = FN JBE 473¢ 

DFN = DEN - 1.D+@ JBE 4740 

FN = DFN JBE 475@ 

IF (NN-1) 4446, 416, 420 JBE 4766 

416 KT = 2 JBE 4770 
TS = 2 JBE 4780 

42@ IF (SX02.LE.FNP1) GO TO 43¢ JBE 4790 
GO TO 13¢ JBE 4800 

43@ ARG = ARG - XO2L + ALOG(FNP1) JBE 4810 
IF (ARG.LT.-ELIM1) GO TO 46¢ JBE 4826 

GO TO 33¢ JBE 483¢ 


446 NZ = N - NN JBE 484¢ 


COLLECTED ALGORITHMS (cont.) 


PRINT 99996, NZ, ALPHA, N, X 
RETURN 


C BACKWARD RECURSION SECTION 
45@ CONTINUE 


C BACKWARD RECUR FROM INDEX ALPHA+NN-1 TO ALPHA 


460 


470 


C ASYMPTOTIC EXPANSION FOR X TO INFINITY WITH FORWARD RECURSION IN 
C OSCILLATORY REGION X.GT.MAX(2@, NU), PROVIDED THE LAST MEMBER 
C OF THE SEQUENCE IS ALSO IN THE REGION. 


480 


490 


500 


516 


526 
530 


549 


NZ = N ~ NN 


IF (NZ.NE.@) PRINT 99996, NZ, ALPHA, N, X 


IF (KT.EQ.2) GO TO 47@ 


Y(NN) = TEMP(1) 

Y(NN-1) = TEMP(2) 

IF (NN.EQ.2) RETURN 

DX = X 

TRX = 2.D+0/DX 

DIM = DFN*TRX 

T = DTM 

K = NN+1 

DO 46¢@ I=3,NN 
K=K-1 
Y(K-2) = TM*Y(K-1) - Y(K) 
DIM = DIM —- TRX 
T™ = DIM 

CONTINUE 

RETURN 

Y(1) = TEMP(2) 

RETURN 


CONTINUE 

IN = ALPHA - TAU + 2. 

IF (IN.LE.@) GO TO 49¢ 

INP] = IN+ 1 

DALPHA = ALPHA ~ FLOAT(INP1) 

KT = l 

GO TO 5¢¢ 

DALPHA = ALPHA 

IN = @ 
= KT 

ARG = X - PIDT*DALPHA - PDF 

SIN (ARG) 

COS (ARG) 

RTTP/RTX 

TX = 8.*X 


ep) 
ow 
“ou oa 


RELB = TOL*ABS (T2) 
ETX 


DO 


WH 


is] 

—~aA2Areuil tt oo it 
to 

ruiloorr 


AP = TRX 


Sl = S1 + 12 


T2 = T2*AP/T1 
= S2 + T2 
IF (ABS(T2).LE.RELB) GO TO 53@ 
AK = AK + 8. 

CONTINUE 

TEMP(IS) = RA*(S1*SB~S2*SA) 

GO TO (544, 55), IS 

DALPHA = DALPHA + 1. 
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4880 
4890 
4900 
491 
4920 
4936 
4940 
4950 


4960 
4976 


4980 
4990 
5000 
5016 
5620 
5030 
50640 
5050 
5060 
50670 
5080 
5090 
51060 
511¢ 
512¢ 
513¢ 
5140 
515¢ 
516¢ 
5170 
5180 
5196 
5200 
521¢ 
522¢ 
523¢ 
5240 
5250 
5260 
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5280 
5290 
5300 
5316 
5320 
5330 
5340 
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539¢ 
5400 
5410 
5420 
543¢ 
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5460 
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5480 
5496 
5500 
551¢ 
552@ 
5530 
5540 
5550 
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557 
5580 
559¢ 
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COLLECTED ALGORITHMS (cont.) 


IS = 2 
TB = SA 
SA = -—SB 
SB = TB 
GO TO 5106 


C FORWARD RECURSION SECTION 
55@ IF (KT.EQ.2) GO TO 47¢ 


S1 = TEMP(1) 
S2 = TEMP(2) 
TX wm 22/X 

TM = DALPHA*TX 


IF (IN.EQ.@) GO TO 5706 
C FORWARD RECUR TO INDEX ALPHA 
DO 56@ I=1,IN 
S = $2 
$2 = TM*§2 - Sl 
T™ = TM + TX 
Sl =§ 
56@ CONTINUE 
IF (NN.EQ.1) GO TO 590 
S$ = §2 


ae 
x 
I 
lar 
<4 
+ 
| 
as) 


57@ CONTINUE 
C FORWARD RECUR FROM INDEX ALPHA TO ALPHA+N-1 
Y(1) = Sl 
¥(2) = $2 
IF (NN.EQ.2) RETURN 
DO 58¢@ I=3,NN 
Y(1) = TM*Y(I-1) - Y(I-2) 
T™ = TM + TX 
58¢@ CONTINUE 
RETURN 
590 Y¥(1) = $2 
RETURN 
C BACKWARD RECURSION WITH NORMALIZATION BY 


C ASYMPTOTIC EXPANSION FOR NU TO INFINITY OR POWER SERIES. 


60% CONTINUE 


C COMPUTATION OF LAST ORDER FOR SERIES NORMALIZATION 


KM = AMAX1(3.-FN,@.) 
TFN = FN + FLOAT (KM) 


TA = (GLN+TFN-@. 9189385332-@.4833333333/TEN) /(TFN+@.5) 
TA = XO2L - TA 

TB = -(1.-1.5/TFN) /TFN 

IN = CE/(-TA+SQRT (TA*TA-CE*TB)) + 1.5 

IN = IN + KM 

GO TO 65¢ 


610 CONTINUE 


C COMPUTATION OF LAST ORDER FOR ASYMPTOTIC EXPANSION NORMALIZATION 


GLN = AZ32 + RA 
IF (ARY.GT.30.) GO TO 63¢ 
RDEN = (PP(4)*ARY+PP(3))*ARY + 1. 
RZDEN = PP(1) + PP(2)*ARY 
TA = RZDEN/RDEN 
IF (W2.LT.@.1¢6) GO TO 620 
TB = GLN/RTARY 
GO TO 640 
62@ TB = (1.259921049+@.1679894730*W2) /FN13 
GO TO 64¢@ 
63@ CONTINUE 
TA = CONI*TCE/ACZ 


TA = ((0.049382716Q@*TA-O. LILILI1L111)*TAt+O 6666656667) *TA*ARY 


IF (W2.LT.@.1¢) GO TO 620 


TB = GLN/RTARY 
649 IN = TA/TB + 1.5 

IF (IN.GT.INLIM) GO TO 319 
650 DX = FLOAT(IN) 

DIM = DFN + DX 

DX = X 

TRX = 2.D+6/DX 

DIM = DIM*TRX 

T™ = DIM 

TA = Q. 

TB = TO 

KK = 1 
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COLLECTED ALGORITHMS (cont.) 


660 CONTINUE 
C BACKWARD RECUR UNINDEXED 
DO 679 I=1,IN 
TB = TM*TB - TA 
DIM = DIM - TRX 
™ = DIM 
67@ CONTINUE 
C NORMALIZATION 
IF (KK.NE.1) GO TO 68@ 


TA = (TA/TB)*TEMP (3) 
TB = TEMP (3) 

KK = 2 

IN = NS 


IF (NS.NE.@) GO TO 660 
68@ Y(NN) = TB 
NZ = N - NN 
IF (NZ.NE.@) PRINT 99996, NZ, ALPHA, N, X 
IF (NN.EQ.1) RETURN 
TB = TM*TB - TA 
DIM = DIM — TRX 
T™ = DIM 
K = NN - 1 
Y(K) = TB 
IF (NN.EQ.2) RETURN 
KM = K - 1 
C BACKWARD RECUR INDEXED 
DO 69¢ I=1,KM 
Y¥(K-1) = TM*Y(K) - Y(K+1) 
DIM = DIM - TRX 
™ = DIM 
K=K-1 
69¢ CONTINUE 
RETURN 
706 PRINT 99999, ALPHA, N, X 
STOP 
716 PRINT 99998, ALPHA, N, X 
STOP 
72@ PRINT 99997, ALPHA, N, X 
STOP 
99999 FORMAT (51H@JBESS CALLED WITH THE ORDER, ALPHA, LESS THAN ZERO 
* /7H ALPHA=,E25.14,3H N=,16,3H X=,E25.14) 
99998 FORMAT (34H@JBESS CALLED WITH N LESS THAN ONE/7H ALPHA=, 
* E25.14,3H N=,16,3H X=,E25.14) 
99997 FORMAT (35H@JBESS CALLED WITH X LESS THAN ZERO/7H ALPHA=, 
* E25.14,3H N=,16,3H X=,E25.14) 
99996 FORMAT (25H@UNDERFLOW IN JBESS, LAST,I6,2@H VALUE(S) OF Y ARRAY, 
* 17H WERE SET TO ZERO/7H ALPHA=,E25.14,3H N=,16,3H X=,E25.14) 
END 
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CDC 6600 Subroutines IBESS and JBESS for Bessel Functions I, (x) and J, (x), 


x20,v=0 [S18] 


{D.E. Amos, 8.L. Daniel, and M.K. Weston, ACM Trans. Math. Software 3, 1 


(March 1977), 93-95] 
Donald E. Amos [Recd 28 July 1977] 


Numerical Mathematics Division 5122, Sandia Laboratories, Albuquerque, NM 


87115 


The following changes should be made in this algorithm: 
(1) Add (immediately after line JBE 6390)’ 
S=TB JBE 6391 


‘To make this change, see “Collected Algorithms from ACM,” pages 511-P1 through 511-P21. 


ACM Transactions on Mathematical Software, Vol. 4, No. 4, December 1978, Page 411. 


COLLECTED ALGORITHMS (cont.) 511-P22- 0 


(2) Add (immediately after line JBE 6400)! 
TA=S JBE 6401 
(3) Replace the date 
1977 
by the date 
March, 1977 
in the lines IBE 180 and JBE 180,” and the date 
1976 
by the date 
March, 1977 
in the line GAM 180. 


? To make these changes, see the issue of ACM Trans. Math. Scftware referenced above, pages 94 


and 95. 
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ALGORITHM 512 

A Normalized Algorithm for the Solution 

of Positive Definite Symmetric Quindiagonal 
Systems of Linear Equations [F4| 


A. BENSON and D. J. EVANS 
Loughborough University of Technology, England 


Key Words and Phrases: linear equations, normalized solution, periodic quindiagonal, 
symmetric positive definite 

CR Categories: 5.14, 5.17 

Language: Fortran 


DESCRIPTION 


In the finite difference solution of elliptic partial differential equations using. block 
iterative methods, there occurs within the iteration scheme a need to solve many 
subsets of the resulting set of linear equations for each block and for each itera- 
tion. The form of the coefficient matrix B of such subsets of equations depends on 
the particular differential equation and the region of integration and on the way 
in which the grid points in the finite difference scheme are ordered. In this algorithm 
we are concerned with the case when B is symmetric, positive definite, and of the 


form 

C1 br GQv-1 by 

bi C2. be a an 

a bo cs bg 3 

ae 
(1) 

an—4 b N—~3 Cn—2 by-2  Gn_2 

On—1 Qn-3 by-2 Cn-4 by-1 

b N an an-2 bw-1 Cn 


Such systems arise, for example, from a two-line grouping of the mesh points for a 
self-adjoint partial differential equation in a rectangular region with periodic 
boundary conditions in one or both coordinate directions. Similar systems also 
arise in the solution of the biharmonic equation in a rectangular region subject to 
periodicity conditions [4]. For nonsymmetric matrices such as might occur if the 
differential equation were not self-adjoint or for circular regions [1], an algorithm 
has been given [2]. For the symmetric, positive definite case, however, it is worth- 
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COLLECTED ALGORITHMS (cont.) 


while to consider a normalized form of the algorithm following Cuthill and Varga 
[3]. This approach makes usc of the result: 
If A is a real NXN, symmetric positive definite matrix, then there exists a 
unique, positive, diagonal matrix D and a unique, real, upper triangular 
matrix 7, with unit diagonal elements such that 


A = DT'TD (2) 


where 7’ denotes the transpose of 7’. 
Assume, then, that in the system of equations 


Bg=s (3) 


the matrix B is symmetric, positive definite, and of the form given by (1). Then B 
has the unique factorization 


B = DT'TD 
where 
D = diag {d:, d2,ds,... , dy} (4) 
and T is given by 
lia fi gu hy ) 
le fe g2 he | 
Ie 1 ens fv-a Qw—s hy— ae 0) 


1 €n-3 (fr_s + Jn—a) hy_s 
1 (€n_2 + gn—2) (fr—2 + hy_2) 
1 (€y_1 + hy_s) 
1 


The elements of the matrices D and T are given by the following relations. 
For the first (NV — 2) columns, the factorization is straightforward, as there is 
no interaction between the elements in 7; so that 


d, = (a), dh = (@ — bY /dy)'”, e: = bi/ch ch, 
and forz = 3,4,...,N —2 
U = A2/di2; v = bi41/diy — eu 
and 


d; = (c; — u“ = ry, Si-2 = u/di, e341 = v/d; . 


For the last two columns auxiliary vectors x and y arc used; so that for column 


(N — 1) if 
U = Ay-3/dy-3, v0 = by-2/dn_2 -— en_3u, 
Y= Ay-r/di, Le = —e21, 
and forz = 3,4,...,N — 2 
Li = Citi — fi-2%i_2, 
then 


i N~-4 1/2 
dvi = i ame = » De + (ty-3 + u)” “+ (ty-2 + »*} ) 


fxs — u/ dy, 
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éyv-2 = v/dy—, 
and fori = 1,2,...,N —2 
gi = «:/dy-1. 


For the final column, we set 


U = Gy-2/dy_2, v = by-s/dy_1 — en—2U, 
“Yu= by/ ds, Y= ay/de — &Y1, 
and for? = 3,4,...,N—1 
Yi = —e6-1Yi-1 — f s-2Y i—2) 
and finally 
N-2 
Yn-1 = Yr — dX JiYi — Yn—2U. 
Then 
N-8 
dy = {tw — 2d, yi — (yn-2 + u)” — (ywa + 0)*}, 
fu = u/dy, 


éyv-1 = v/dy, 
and forz = 1,2,...,N—1 
h; = y:i/ dn. 


The factorization stage is then complete. To solve the linear system (3), with 
coefficient matrix B as given by (1), we rewrite it in the equivalent form: 


DT'TD¢ =s ic. T’T(D¢) = D's; (6) 
so that putting 
Dg =z, D's=q, (7) 
the system becomes 
TTz=q, 


which may be solved directly for z in terms of the auxiliary vector p whose ele- 
ments are given by 


Pi = 41, P22 = G2 — Gipi, 
and forz = 3,4,...,N — 2 
Pi = Qi — C1 Pir — fre Pie. 
Finally, 


N—4 


Pu-i = Qv-1 — (€n-2 + gy-2)Pw—2 — (fy_s + 9n—s)Dn—3 — > Jipi, 
N-8 
Pw = Qn — (@n-1 + hy) pra — (fy_2 + hy2) pyre — a hips. 
The elements of z are then obtained by a back substitution process so that 
en = Py, 
ty = Pra — (éxa + hya)én, 


&n-2 = Py-2 — (€n—2 + Jn_-2) &n—-1 — (fr—2 Se hy_2) EN» 
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and fori = N — 8,...,3,2,1 
i= Dim C2 — fizise — gi tn-1 — hi2n. 


The final solution ¢ is then obtained from ¢ = Dz using only one division per 
component. 


Storage Management Used in the Program 
The algorithm has been written in the form of three subroutines, as follows. 
1. FACTOR(A,B,C,G,H,N) 

This subroutine performs the factorization stage. A. matrix of the form (1) is 
input as three vectors a, b, ec, which are overwritten during the course of the fac- 
torization. The diagonal elements of D, i.e. d: to dn, replace the coefficients ¢: to 
Cn; in the vectors b and a are stored the elements é: to én_1 and fi to fn_2, respec- 
tively, which occur in the matrix 7. In the factorization formulas two vectors 
x and y are used, but in the program these are replaced by g and h which are in 
turn overwritten by the gi to gn—2 and fi to ha_s values which occur in the last two 
columns of 7’. 

2. RHS(D,S,N) 

This subroutine forms D's, where D is a diagonal matrix whose elements are 
stored in a vector d. The input vector s is overwritten by the result vector. 
3. SOLVE(E,F,G,H,Q,N) 

This subroutine solves the set of equations T’7'z == q for T as given by (5). 
The solution is effected in two stages, viz. a forward substitution for p where 
Tp = q and a backward substitution for z where 7'z = p. The input vector q 
is overwritten first by the intermediate solution p and finally by the result z. 


To solve (3) directly with B as given by (1) would then require the subroutine 
calls: 
CALL FACTOR(A,B,C,G,H,N) 
CALL RHS(C,8,N) 
CALL SOLVE(B,A,G,H,S,N) 
CALL RHS(C,S,N) 


The reason for the three subroutines (instead of a single one), however, is that 
in a typical block successive overrelaxation process the three stages need to be 
performed at different points and possibly a different number of times. For instance, 
if the matrix B remains the same for each block, then the factorization necd be 
performed only once. Morcover, the set of equations (3) is typically solved as part 
of an iterative procedure so that for block r, if k represents the iteration count 
then we have for successive block overrelaxation 


(k+1) k-+1) (k) (k) 
B,@, = s( oo4 ) Or ) 7-1). 


However, if D,br™ = zr”, then the iteration is carried out in the transformed 
variable z, so that 


, k+1 k+1 k k 
Te Ta = q( Zit”, 2”, 29: 


(K+1) K 


until for some value K of k, z, and z,“ agree to some specified accuracy for 
all values of r. The final result is then obtained from ¢ = D™‘z. The process is 
considered to be a normalized Choleski technique uscd in an inner loop where the 
need to include the division is eliminated until the final result is achieved. 


Normalized Algorithm Versus Choleski Factorization 


Let us briefly consider the differences between using the normalized factorization 
B = DT'TD as opposcd to a standard Choleski factorization B = LL’ which takes 
into account the structure of the nonzero elements of .B. 
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The normalized form is clearly similar fo a Choleski factorization since D7” 
is a lower triangular matrix, say Z,so that B = LL’. 

Moreover, if we consider B = LL’, then the formulas for determining the ele- 
ments of ZL are very similar to those already given for the elements of D and T. 

However, a work count of the two algorithms shows that the normalized version 
requires 2n more divisions than the Choleski form, this extra work occurring in the 
factorization stage. Having factorized B, the two solution processes for determining 
¢@ from B¢g = s require the same amount of work. Consequently, for the straight- 
forward solution of a set of equations Bg = s with B as in (1), the Choleski fac- 
torization is preferable because less work is involved. 

However, as we have seen, the B matrices are likely to occur in problems where 
the solution of Bg = s is incorporated into an iterative procedure. In this case 
for the normalized version, n divisions per block would be saved in each iteration 
in excess of one (since the iteration is effected in a transformed variable thus saving 
the final division). Let us consider all possible cases for the B matrices, i.e. 

(i) B= B,™: the matrices change from block to block and with each iteration; 


(ii) B = B®: the matrices change with each iteration but not from block to 
block ; 

(iii) B = B,: the matrices change from block to block but not with each iteration; 

(iv) B= B: _ the matrices remain constant throughout the process. 


Cases (ili) and (iv) are the most likely to occur in practice. 

For (i), the Choleski factorization always involves less work. 

For (ii), the Choleski form is more efficient if the number of blocks is less than 
three. For three or more blocks, the normalized form is more efficient if the number 
of iterations exceeds two. 

For (iii) and (iv), i.e. the most likely cases, the normalized form is more efficient, 
from the point of view of number of operations involved, if the number of iterations 
is again more than two. 

Consequently we conclude that for the majority of problems involving a block 
overrelaxation technique in which the blocks have a coefficient matrix of the form 
(1), the normalized algorithm as presented here would involve less work than a 
sparse Choleski form. 
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ALGORITHM 

SUBROUTINE FACTOR(A, B, C, G, H, N) FAC 10 
C THE SUBROUTINE IS A NORMALISED FACTORISATION OF A SQUARE MATRIX OF FAC 20 
C ORDER GREATER THAN 4. FAC 36 
C THE COEFFICIENT MATRIX P IS SYMMETRIC,POSITIVE DEFINITE AND FAC 4¢ 
C QUINDIAGONAL WITH NON-ZERO ELEMENTS ALSO IN THE LAST TWO COLUMNS OF FAC 50 
C THE FIRST ROW, THE LAST COLUMN OF THE SECOND ROW, THE FIRST COLUMN FAC 6 
C OF ROW (N-1) AND THE FIRST TWO COLUMNS OF THE LAST ROW. A,B,C ARE FAC 7¢ 
C VECTORS EACH OF N ELEMENTS CONTAINING RESPECTIVELY THE SUPER-SUPER~ FAC 8¢@ 
C DIAGONAL, SUPER-DIAGONAL AND DIAGONAL ELEMENTS OF P I.E. P(I,I+2), FAC 96 
C P(I,I+1) AND P(I,I). THE MATRIX ELEMENTS P(1,N-1), P(1,N), P(2,N) FAC 100 
C ARE STORED IN A(N-1), B(N), A(N) RESPECTIVELY, AS ARE P(N-1,1), FAC 11¢ 
C P(N,1) AND P(N, 2) FAC 120 
C THE MATRIX P IS FACTORISED INTO P=DRTD WHERE D IS A DIAGONAL MATRIX FAC 13¢ 
C AND T IS A REAL, UPPER TRIANGULAR MATRIX WITH UNIT DIAGONAL ELEMENTS FAC 146 
C AND NON-ZERO ELEMENTS IN THE LAST TWO COLUMNS AND ON THE SUPER- AND FAC 15@ 
C SUPER-SUPER-DIAGONALS. R DENOTES THE TRANSPOSE OF T. FAC 160 
C THE INPUT VECTORS ARE OVERWRITTEN DURING THE FACTORISATION STAGE SO FAC 170 
C THAT VECTOR C CONTAINS THE DIAGONAL ELEMENTS OF D, VECTOR B CONTAINS FAC 180 
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C THE SUBROUTINE SOLVES THE SET OF N LINEAR EQUATIONS RTZ=Q WHERE T IS 
C AN UPPER TRIANGULAR MATRIX WITH UNIT ELEMENTS ON THE DIAGONAL AND R 
C DENOTES THE TRANSPOSE OF T. THE OTHER NON-ZERO ELEMENTS OF T OCCUR ON 
C THE SUPER-DIAGONAL I.E. T(I,I+1), THE SUPER-SUPER-DIAGONAL I.E. 


THE ELEMENTS T(I,I+1) FOR I=1 TO N-3 AND VECTOR A CONTAINS THE 
ELEMENTS T(I,I+2) FOR I=1 TO N-4. 
TWO RESULT VECTORS. G,H ARE USED TO STORE THE ELEMENTS T(I,N-1) FOR 
I=1 TO N-4 AND T(I,N) FOR I=1 TO N-3 RESPECTIVELY. THE ELEMENTS 
T(N-3,N-1), T(N-2,N-1), T(N-2,N) AND T(N-1,N) ARE THEN GIVEN BY 
A(N-3)+G(N-3), B(N-2)+G(N-2), A(N-2)+H(N-2), B(N-1)+H(N-1) 
RESPECTIVELY. 
DIMENSION A(N), B(N), C(N), G(N), H(N) 
Nl =N-1 
N2=N-2 
N3 =N-3 
N46=N-4 
C(1) = SQRT(C(1)) 
V = B(1)/C(1) 
C(2) = SQRT(C(2)-V*V) 
B(1) = V/C(2) 
DO 1¢ I=3,N2 
ee aoe 
12278 


10 


20 


3¢ 


4g 


50 


60 


70 


80 


U = A(I2)/C(12) 
V = B(I1)/C(11) - B(12)*U 
C(I) = SQRT(C(L)-U*U-V*V) 
A(12) = U/c(t) 
B(I1) = V/C(I) 
CONTINUE 
G(1) = A(N1)/c(1) 
G(2) = -B(1)*G(1) 
U = A(N3)/C(N3) 
V = B(N2)/C(N2) - B(N3)*U 
DO 2¢ I=3,N2 
G(I) = ~B(I-1)*G(I-1) - A(I-2)*G(I-2) 
CONTINUE 
W= @.¢ 
DO 3@ I=1,N4 
W = W + G(1I)*G(1) 
CONTINUE 
C(N1) = SQRT(C(N1)-W-(G(N3)+U) **2-(G(N2)+V)**2) 
W = 1.6/C(N1) 
A(N3) = U*W 
B(N2) = V*W 
DO 4@ I=1,N2 
G(I) = G(1)*W 
CONTINUE 
H(1) = B(N)/C(1) 
H(2) = A(N)/C(2) - B(1)*H(1) 
U = A(N2)/C(N2) 
V = B(N1)/C(NL) - B(N2)*U 
DO 5¢@ I=3,N1 
H(L) = -B(I-1)*H(I-1) - A(I-2)*H(I-2) 
CONTINUE 
W= ¢.¢ 
DO 6@ I=1,N2 
W = W + G(L)*H(1) 
CONTINUE 
H(N1) = H(NL) - W - G(N2)*U 
W = 6.0 
DO 7@ I=1,N3 
W = W + H(I)*H(I) 
CONTINUE 
C(N) = SQRT(C(N)-W-(H(N2)+U) **2—(H(N1L)+V) **2) 
W = 1.0/C(N) 


DO 8@ I=1,N1 
H(L) = H(I)*W 

CONTINUE 

RETURN 

END 


SUBROUTINE SOLVE(E, F, G, H, Q, N) 


FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
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FAC 
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FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
FAC 
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FAC 
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FAC 
FAC 
FAC 
FAC 
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FAC 
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SOL 
SOL 
SOL 
SOL 
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C THE SUBROUTINE FORMS Q WHERE BQ=S AND B IS A DIAGONAL MATRIX OF ORDER 
C N WHOSE NON-ZERO DIAGONAL ENTRIES ARE STORED IN A VECTOR D OF N 


T(I,I+2) AND IN THE LAST TWO COLUMNS I.E. T(I,N-1) AND T(I,N). 


THE STORAGE IS SUCH THAT THE FOLLOWING ARE EQUIVALENT---- 


THE SOLUTION IS EFFECTED BY A FORWARD SUBSTITUTION PROCESS FOLLOWED 
BY A BACKWARD SUBSTITUTION AND THE INPUT VECTOR Q IS SUCCESSIVELY 
OVERWRITTEN BY THE INTERMEDIATE SOLUTION (OF THE FORWARD ELIMINATION) 


T(I,I+1) AND E(I) FOR I=1 TO N-3 
T(I,I+2) AND F(I) FOR I=1 TO N-4 
T(I,N-1) AND G(I) FOR I=1 TO N=4 
T(I,N) AND H(1) FOR I=1 TO N-3 
T(N-3,N-1) AND F(N-3)+G(N-3) 
T(N-2,N-1) AND E(N-2)+G(N-2) 
T(N-2,N) AND F(N-2)+H(N-2) 
T(N-1,N) AND E(N-1)+H(N-1) 


AND THEN THE FINAL SOLUTION. 


10 


20 


* 


DIMENSION E(N), F(N), G(N), H(N), Q(N) 


NI =N- 1 
N2 =N- 2 

N3 =N- 3 

Q(2) = Q(2) ~ E(1)*Q(1) 
DO 1@ I=3,N2 


Q(I) = Q(I) - E(I-1)*Q(I-1) - F(I-2)*Q(I~-2) 
CONTINUE 


»N2 
G(I)*Q(T) 
H(1)*Q(T) 


Q(N1) = Q(N1) - E(N2)*Q(N2) - F(N3)*Q(N3) - U 
Q(N) = Q(N) ~ (E(NI)+H(N1))*Q(NL) - F(N2)*Q(N2) - V 
Q(N1) = Q(N1) - (E(N1)-+I(NL))*Q(N) 
Q(N2) = Q(N2) - (E(N2)+G(N2))*Q(NL) - (F(N2)+H(N2))*Q(N) 
DO 3@ II=1,N3 
I=N3 -IIK+1 
Q(Z) = Q(T) - E(I)*Q(I+1) - F(I)*Q(I+2) - G(I)*Q(N1) - 
saoan (1)*Q(N1) 


30 CONTINUE 


RETURN 
END 


SUBROUTINE RHS(D, S, N) 


C ELEMENTS, THE INPUT VECTOR S IS OVERWRITTEN BY THE RESULT Q 


DIMENSION D(N), S(N) 
DO 19 I=1,N 
S(I) = S(I)/D(1) 


10 CONTINUE 


RETURN 
END 
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DESCRIPTION 


Algorithms for in-place matrix transposition make use of the cyclic structure of 
the transposition mapping. A clear introduction to the process was given in 
1958 by Windley [6]. In 1968 Boothroyd presented ACM Algorithm 302 [1]. Then 
in 1970 Laflin and Brefner presented ACM Algorithm 380 which they showed to 
be significantly faster than Algorithm 302 [4]. 

In this paper a number of theoretical results describing the transposition process 
are derived. Algorithms 302 and 380 are described and applications of some of the 
theoretical results to accelerate both algorithms are described. Finally, experi- 
mental comparison of the performance of Algorithm 380 and the improved version 
is presented. 


Theoretical Development 


Fortran conventions are assumed. The mXn matrix A is stored by column in a 
vector 7 of adjacent storage locations. It is convenient to number components of 
4 from 0 to mn — 1. Using this convention, matrix element A (J, J) is stored in yz , 
where k = m(J — 1) + I — 1. The transposition process moves the contents of 
yx tO Yp where p = nUJ — 1) + J — 1. Thus the transposition process can be 
regarded as a permutation mapping acting on the indices of 7. The symbol 7 is 
used to denote this mapping, and the set of indices which + permutes is denoted by 
S. With this notation, S = [0, 1,..., mn — 1] and the formal equation r(k) = p 
indicates that the contents of storage location y, is moved to location y, in the 
transposition process. 

The theoretical material is organized in three sections: additional notation, 
development of general properties of 7, and description of the fixed point properties 
of 7. 


Notation 
Symbols used in this paper are as follows. 


C(x) Cycle of x containing element x € S. C(x) is generated by repeated appli- 
cation of r to w., i.e. C(x) = [x, r(x), (x), ...]. 
L(x) Length of the cycle C(z). 
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P(d) Number of cycles of length d. 


u(n) Mébius function; for n having prime factorization, n = Pi°!...P,*, 
w(n) = {1 if n=1, 
(-1) if ga=aq=---=e=1, 
0 otherwise. 


[a, b] Greatest common divisor of a and b. 
d|u  disa divisor of u. 


General Properties of + 


An analytic expression for z is given in [1]. That is, for x € S, 


Pee nxmodmn—1 if x mn —1, (1) 
~ \mn — 1 if c= mn—1. 
In this paper the symbols x and y represent any element of S except mn — 1, and 
all algebraic expressions involving these are assumed evaluated mod mn — 1. 
That 7 is a linear mapping is obtained directly from (1). That is, 
(ax + by) = an(x) + br(y). (2) 


This property is used to relate z to its fixed points. 
The inverse mapping is used in both Algorithms 302 and 380 to traverse the 
cycles in the reverse direction. 


my for y€Es,yAmn—Il, 
mn—1 for y=mn-—-1. 

Proor. + (m(y)) = a(m (y)) = mny mod mn — 1 = ((mn — 1)y + y) 
mod mn — 1 = y. 

The transposition algorithms depend upon the cyclic structure of 7. Two theo- 
rems are presented which describe the properties of these cycles. Theorem 2 shows 
how to find the length of the longest cycle (i.e. the cycles starting with « = 1, 
A(2, 1)). It also demonstrates that the length of any cycle must be a divisor of 
the length of the longest cycle. Theorem 3 provides a number theoretic formula 
which gives the number of cycles of any length. No application has been found for 
Theorem 3, but it may be of interest to other researchers. The interested reader is 
referred to [2] for the proof. 

THEOREM 2. The order of m is L(1). 

Proor. The order of a permutation mapping is the least common multiple of 
the lengths of its cycles [5]. Let d = L(1). Then n’ = 1 mod mn — 1. It is sufficient 
to show, for any y € S, that r*(y) = y. If y = mn -- 1, then the theorem is trivi- 
ally true. For y # mn — 1, 2°(y) = n°ymod mn — 1 = y. 

TueroremM 3. Assume that k > 1. The number of cycles of length k,¥P(k), 1s given 
by P(k) = k* Doan w(k/d)(n* — 1, mn — 1]. 

The number of fixed points (kK = 1) is discussed in the next section. 


TuEoreM 1. + (y) = 
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Fixed Point Properties of z 


It is mainly through the symmetry with respect to the fixed points that computa- 
tional leverage is gained. The mapping always has at least two fixed points, 0 and 
mn — 1. If S has a midpoint, then the midpoint is also a fixed point. Formally, 

THEOREM 4. [fm and n are odd, then 4(mn — 1) isa fixed point. 

Proor. Let n = 2k + 1. By eq. (1), af 40mm — 1)] = 4 @k + 1)(mn — 1) = 
2(mn — 1) 

Two formulas for calculation of the number of fixed points of 7 are now given. 
Let ns represent the number of fixed points of a. 

THEOREM 5. ny — 1 = [n — 1, mn — 1] = [m — 1, mn — 1], and the fixed points 
are uniformly spaced at 0, d, 2d,..., whered = (mn — 1)/(n; — 1). 

Proor. Because of eq. (1), all the fixed points of r except mn — 1 satisfy the 
congruence x(n — 1) = 0 mod mn — 1. The solutions of this congruence are 0, d, 
2d,..., where d = (mn — 1)/[n — 1, mn — 1]. (See [5, ch. 8].) Clearly 7 and a” 
have the same fixed points; sony — 1 = [m — 1, mn — 1] by symmetry. 


0 
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THEOREM 6. ny — 1 = [m — 1, — 1]. 

Proor. Let d = [m — 1, n — 1]. By Theorem 5, (ny — 1) | d. Conversely, 
the identity (n ~ 1)(m + 1) = mn — 1+ ((n — 1) — (m — 1)) shows that 
d|mn — 1. This and Theorem 5 show that d| (ny — 1). Henced = n,; — 1. 

The mapping 7 is symmetric with respect to fixed points in the sense that for 
fixed point a, where a ~ mn — 1, 


m(a+2#) =atn(z). (3) 


The fixed point 0 is usually the only fixed point satisfying eq. (3). That is, if 
m #~ land n ¥ 1, the probability that. 7 has exactly two fixed points (0 and mn — 1) 
is the probability that m — 1 and n — 1 are relatively prime (Theorem 6). This 
probability is 6/m” = .608 [3, ch. 18]. The symmetry with respect to 0 is applied 
in Algorithm 380 and extended in this paper. 

When a = 0, the nontrivial part of eq. (3) is 


a(—xz) = —m(x). (4) 


It is evident from eq. (4) that C(—x) = —C(x), and consequently that L(x) 
= L(—2). Equation (4) was proved by Laflin and Brefner [4] by more compli- 
cated methods and was the basis for their improved algorithm. We call the sym- 
metric cycle C(—z) the companion cycle. The cycle and the companion cycle in 
some cases coincide. In this event the length of the cycle is an even integer, and 
x and —¥x are separated by half the cycle. That is, 

Tueorem 7. C(x) = C(—2) #f and only if —2 = nix, where k = L(x) /2. 

Proor. Since —xz € C(x) there is a smallest integer k such that —x = n‘x. 
This implies that « = n'( —zx), which in turn implies that 2 = n‘(n*(x)). Thus 
L(x) | 2k. Since k < L(x), we must have L(x) = 2k. Conversely, if n'x = —z, 
then —a € C(x) and C(x) = C(—2z). 


Algorithm Improvement 


Algorithms 302 and 380 are now described. For each algorithm, efficiency improve- 
ments based on the theoretical development in the previous section are discussed. 
Finally, timing comparisons are given. 

Algorithm 302 [1]. For i = 1,..., mn — 1, compute the index j = 7 ‘(2) and 
exchange y; and y;, provided 7 > 12. The case 7 < 7 indicates that the element 
originally in y; 18 now elsewhere following previous exchanges. Then search the 
cycle C(j) for the first index jr > 7 and exchange y;, and y,. It terminates when 
Ymn—2 18 filled. 

Symmetry with respect to the fixed point 0 [eq. (4)] can be exploited to ac- 
celerate Algorithm 302. The idea is to process the array from both ends toward the 


middle simuitaneously. That is, process element 7 and —7 mod (mn — 1) con- 
currently. This reduces the time spent searching cycles. The revised algorithm 
is then: 

1. Set z = 0. 


2. Increment 7. If 7 > (mn/2 — 1), terminate. Otherwise, perform step 3 (mn/2 is truncated to 
integer value because of Theorem 4). 

3. Compute 7 as follows: Let r be the smallest positive integer such that 7 < m“(i) < 
mn —1—%. Thenj = r“(z). 

4. If 7 = 7, return to step 2. Otherwise, exchange y; and y; and perform step 5. 

5. If7 = mn — 1 — 7, return to step 2. Otherwise, perform the symmetric exchange of Ymn—1-; 
and Ymn—1-i- (If 7 = mn — 1 — 7, this exchange was already performed in step 4.) Return 
to step 2. 


Algorithm 380 [4]. First the number of fixed points is determined by testing each 
element in the array to see if (i) = 2. Then the array is scanned from lowest to 
nighest subscript. Each array subscript in turn is checked to see if that subscript 
is the smallest subscript in its cycle. Whenever such an element is found, the entire 
cycle is moved. If the companion cycle is distinct, then the companion cycle is 
moved after movement of the cycle is complete. The algorithm keeps track of the 
total number of elements moved and terminates when all (mn) elements have 
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been moved. It is interesting to note that Algorithm 380 works its way backwards 
around each cycle, using the inverse, saving itself a fetch and store for each element 
moved. Algorithm 380 can achicve greater efficiency if scratch storage is available. 
The scratch storage is utilized to keep track of the elements which have already 
been moved. 

The improvements to Algorithm 380 are based again on the symmetry with 
respect to 0 and upon the calculations of the number of fixed points. Theorem 6 
allows use of Euclid’s algorithm to calculate the number of fixed points. Theorem 7 
and eq. (4) allow the processing of a cycle and its companion concurrently. When 
the cycle and its companion coincide, the process is terminated halfway through 
the cycle (Theorem 7). We also used the linearity to calculate r(x + 1) = r(x) +n 
to start the next cycle. It is interesting to note that on the computer used (CDC 
6600 using the RUN compiler), the calculation of mz mod mn — 1 using the system 
modulo functions is slower than using the formulation used in Algorithm 380. 


Timing Comparisons 

The timing tests utilized a set of 21 test matrices which were presented in [4]. 
The per-element transposition time is defined to be the time required to transpose 
a matrix divided by the number of elements in the matrix. Each algorithm was 
tested on the complete set of test matrices and the average per-element transposi- 


Table I 
Average per-element 
Algorithm transposition time (us) 
Algorithm 302 92.2 
Algorithm 302 (revised) 67.1 
Algorithm 380 (without scratch storage) 70.7 
Algorithm 380 (with (m+n)/2 scratch storage) 46.9 
Algorithm 380 (revised) (without scratch storage) 49.2 
Algorithm 380 (revised) (with (m-+n)/2 scratch storage) 28.5 
Table II 
IWRK = (M+N)/2 IWRK = 1 
Original Revised 2X(T1—T2) Original Revised 2X(T3—T4) 
Size MXN Ti* T2* (T1+T2) T3* T4* (T3+T4) 
7X 60 1.58 84 .61 2.45 1.63 .40 
7X 70 1.71 .86 .66 2.52 1.62 43 
7X 80 3.09 2.01 42 4.15 2.96 .33 
7x 90 2.32 1.21 .63 5.01 3.52 .35 
7 X 100 2.50 1.28 .65 3.88 2.46 45 
8 x 60 1.63 84 .64 1.66 87 .62 
8 xX 70 3.46 2.29 41 4.94 3.6 .3l 
8 X 80 4.50 3.10 37 6.69 5.02 .29 
8 xX 90 2.53 1.25 .68 2.55 1.22 71 
8 X 100 3.96 2.41 49 7.28 5.13 .35 
9 xX 60 2.44 1.42 .53 4.12 2.85 .36 
9x 70 3.32 2.11 -45 5.65 4.02 34 
9x 80 2.56 1.22 71 2.49 1.24 .67 
9x 90 2.81 1.45 -64 4.13 2.66 .43 
9 X 100 3.28 1.84 -56 7.44 5.438 ol 
45 X 50 11.19 7.07 -45 19.39 14,20 .3l 
45 <X 60 9.54 4.70 .68 9.22 4.66 .66 
46 x 50 16.19 11.23 .36 25.49 19.57 .26 
46 X 60 17.49 12.37 34 27.96 21.57 .26 
47 X 50 18.45 13.54 31 25.90 20.37 24 
47 X 


60 9.29 4.94 61 9.65 4.89 65 


* Times are given in seconds/100. 
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tion time was calculated. These are summarized in Table I. A detailed comparison 
of the best algorithms (380 and the revised 380) is presented in Table IT in the 
format utilized in [4]. All tests were performed using a CDC 6600, with compilation 
performed by the RUN compiler. 
The simple modification of Algorithm 302 resulted in about a 25-percent eff- 
ciency improvement (Table I). The performance improvement of the revised 
Algorithm 380 varied from 20 percent to 70 percent on individual test matrices 
(Table II) with an average of about 35 percent. 
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SUBROUTINE TRANS(A, M, N, MN, MOVE, IWRK, IOK) 
RREKK 


ALGORITHM 380 - REVISED 


REKKK 


A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH 
CONTAINS THE MXN MATRIX TO BE TRANSPOSED (STORED 
COLUMNWISE). MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK 
USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE 
VALUE IWRK=(M+N)/2 IS RECOMMENDED. LOK INDICATES THE 
SUCCESS OR FAILURE OF THE ROUTINE. 
NORMAL RETURN LOK=@ 
ERRORS IOK=-1 ,MN NOT EQUAL TO M*N 

IOK=-2 ,IWRK NEGATIVE OR ZERO 

IOK.GT.@, (SHOULD NEVER OCCUR) ,IN THIS CASE 
WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH 
IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED 
NOTE * MOVE(I) WILL STAY ZERO FOR FIXED POINTS 

DIMENSION A(MN), MOVE(IWRK) 


CHECK ARGUMENTS AND INITIALIZE. 


IF (M.LT.2 .OR. N.LT.2) GO TO 120 
IF (MN.NE.M*N) GO TO 18¢ 

IF (IWRK.LT.1) GO TO 19¢ 

IF (M.EQ.N) GO TO 130 


NCOUNT = 2 
K = MN - 1 
DO 19 I=1,IWRK 
MOVE(I) = @ 
19 CONTINUE 


IF (M.LT.3 .OR. N.LT.3) GO TO 3 
CALCULATE THE NUMBER OF FIXED POINTS, EUCLIDS ALGORITHM 
FOR GCD(M-1,N-1). 


IR2 = M- 1 
IRI =N- 1 
20 IR@ = MOD(IR2,IR1) 
IR2 = IRI 
IRL = IR@ 


IF (IR@.NE.@) GO TO 2¢ 
NCOUNT = NCOUNT + IR2 - 1 
SET INITIAL VALUES FOR SEARCH 
39 T=1 
IM = M 
AT LEAST ONE LOOP MUST BE RE~ARRANGED 
GO TO 8@ 
SEARCH FOR LOOPS TO REARRANGE 
49 MAX = K -I 
Ir=I+il 
IF (1.GT.MAX) GO TO 16¢@ 
IM = IM+M 
IF (IM.GT.K) IM = IM- K 
I2 = IM 
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IF (I1.EQ.12) GO TO 4¢ TRA 510 

IF (I.GT.IWRK) GO TO 6¢ TRA 526 

IF (MOVE(1L).EQ.@) GO TO 8@ TRA 530 

GO TO 4@ TRA 54¢ 

5@ 12 = M*I1 - K*(11/N) TRA 556 
6@ IF (I12.LE.I .OR. I2.GE.MAX) GO TO 70 TRA 560 
Il = 12 TRA 570 

GO TO 5@ TRA 580 

7@ IF (12.NE.1) GO TO 4@ TRA 59¢ 
C REARRANGE THE ELEMENTS OF A LOOP AND ITS COMPANION LOOP TRA 600 
84 Il = I TRA 61 
KMI = K -I TRA 620 

B = A(I1+1) TRA 63¢@ 

I1C = KMI TRA 640 

C = A(I1C+1) TRA 650 

9@ I2 = M*I1 — K*(I1/N) TRA 660 
12c = K - 12 TRA 670 

IF (I11.LE.IWRK) MOVE(I1) = 2 TRA 68 

IF (I1C.LE.IWRK) MOVE(I1C) = 2 TRA 690 
NCOUNT = NCOUNT + 2 TRA 700 

IF (12.EQ.1) GO TO 11 TRA 71¢ 

IF (12.EQ.KMI) GO TO 1¢ TRA 720 
A(I14+1) = A(12+1) TRA 730 
A(I1C+1) = A(1I2G+1) TRA 74 

Il = 12 TRA 750 

Ilc = 12¢ TRA 760 

GO TO 9¢ TRA 770 

C FINAL STORE AND TEST FOR FINISHED TRA 780 
190 D=B TRA 790 
B=C TRA 800 

Cc =D TRA 810 

116 A(I14+1) = B TRA 820 
A(I1c+1) = C TRA 83@ 

IF (NCOUNT.LT.MN) GO TO 4@ TRA 3406 

C NORMAL RETURN TRA 850 
12@ IOK = @ TRA 86¢@ 
RETURN TRA 87@ 

C IF MATRIX IS SQUARE,EXCHANGE ELEMENTS A(I,J) AND A(J,I). TRA 880 
130 NI =N-1 TRA 89¢ 
DO 15@ I=1,N1 TRA 960 
Jl=i1I+1 TRA 910 

DO L4@ J=J1,N TRA 92 

Il = I + (J-1)*N TRA 930 

I2 = J + (I-1)*M TRA 946 

B = A(I1) TRA 95¢ 

A(I1) = A(12) TRA 960 

A(12) = B TRA 970 

149 CONTINUE TRA 98 
159 CONTINUE TRA 990 
GO TO 12¢ TRA 10060 

C ERROR RETURNS. TRA 1010 
160 LOK = I TRA 1626 
17@ RETURN TRA 1030 
18@ IOK = -1 TRA 104@ 
GO TO 17¢ TRA 1050 

199 IOK = -2 TRA 106¢ 
GO TO 176 TRA 1070 


END TRA 1080 
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REMARK ON ALGORITHM 513 


Analysis of In-Situ Transposition [F1] 
[E.G. Cate and D.W. Twigg, ACM Trans. Math. Software 3, 1 (March 1977), 
104-110] 


and 
REMARK ON ALGORITHM 467 


Matrix Transposition in Place [F1] 
[N. Brenner, Comm. ACM 16, 11 (Nov. 1973), 692-694] 


Burton L. Leathers [Recd 8 March 1978 and 19 May 1978] 
Faculty of Human Kinetics and Leisure Studies, University of Waterloo, Water- 
loo, Ont., Canada 


It is somewhat distressing to note the publication of Algorithm 513. While the 
algorithm is, as claimed, an improvement over Algorithm 380 [1], it is by no 
means as good as Algorithm 467, which was published long before Algorithm 513 
was even submitted for publication. A reanalysis of the timing figures in Algo- 
rithms 467 and 513 suggests very strongly that Algorithm 467 is superior to 
Algorithm 513 except, possibly, when the modulus of the generating function for 
the transposition permutation is prime. 

A direct comparison of the algorithms was performed using the Fortran G 
(nonoptimized) compiler on an IBM 370/158 running under VM/CMS. The 
results, reported in Table I, indicate quite clearly that Algorithm 467 enjoys a 
nearly 2:1 advantage except when the modulus is prime. It should be noted that 
it is not so much that Algorithm 467 is degraded in this case as that Algorithm 
513 performs exceptionally well. 


Table I. Timing Results for Algorithms 467 and 513 
(All times are in milliseconds. Work area sizes are (R + C)/2 in all cases.) 


Rows Columns Modulus 467 513 513/467 
45 50 13.173 58 88 1.52 
45 60 2699 72 68 94 
45 180 7.13.89 212 444 2.08 
45 200 8999 214 199 .93 
46 50 11719 58 128 2.21 
46 60 31.89 72 147 2.04 
46 180 17.487 213 359 1.69 
46 200 9199 212 181 85 
47 50 34.29 54 134 2.46 
47 60 2819 66 62 94 
47 180 11.769 207 411 1.99 
AT 200 2.13.241 430 628 1.46 
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ALGORITHM 514 


A New Method of Cubic Curve Fitting 
Using Local Data [E2| 


T. M. R. ELLIS and D. H. McLAIN 
University of Sheffield, England 


Key Words and Phrases: interpolation, cubic splines, local data 
CR Categories: 5.13 
Language: Algol 


DESCRIPTION 


This algorithm is a local interpolation method to find an approximating function 
y = f(x) through a set of given data points (#;, y;) with ma <--- <a < win 
< -:-+. Probably the best known methods for this are cubic splines [8, 6, 7] and 
the ‘classical’? Lagrangian polynomial interpolation, of which Aitken’s method is 
perhaps the most stable implementation [2]. Both of these methods are nonlocal, 
i.e. the interpolated values depend on all the data points. Under many circum- 
stances, however, it is desirable to use a local interpolation method for which the 
values of the interpolating function depend only on a few of the nearest data 
points. For example, a local method may be preferred in an interactive system 
where one does not want to recalculate a complete picture when one point is changed, 
or where one wants to save storage in multidimensional interpolation. 

The method used in our algorithm is similar to cubic spline interpolation in 
that different cubic, or third degree, polynomials y = f;(x) represent the function 
between different pairs of data points (%;, y:) — (%i1, ys) and in that the 
coefficients are chosen to ensure continuity of the function and its first derivative at 
each data point. We have, however, sacrificed the spline’s continuity of the second 
derivative in order to ensure that the coefficients depend only on the local data 
points. 

A similar approach is described by Maude [4] which also ensures the continuity 
of the function and its first derivative at each data point. However, Maude’s 
functions, at their simplest, reduce to quintic (fifth degree) polynomials, whereas 
ours are cubic polynomials with resulting computational advantages. Another 
method with a similar goal is due to Akima [1]. But whereas Akima’s method is 
designed from geometrical considerations, ours is algebraic and appears to have 
some practical advantages. Thus our method gives an exact fit to the original 
polynomial f(x) if the data points satisfy a cubic equation y; = f(a:). As a result, 
in general it is more accurate for data of mathematical origin, or where smooth 
curves are expected. Our algorithm also appears to give more spline-like functions 
than Akima’s, and in particular tends to produce much smaller discontinuities in 
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the second derivatives at the data points. This is particularly important when 
interpolating surfaces, 2 = f(x, y), by interpolating successively in two inde- 
pendent directions, x and y; for when depicting a perspective view of the surface, 
for example, a discontinuity in the second derivative of the function often results 
in a noticeable irregularity (a kink) in a visible edge. 

Tables I and II compare the performance of our algorithm with other interpola- 
tion methods, and give the results obtained from a program run on a Control 
Data 7600 which applies six methods to data generated from five mathematical 
functions. Table I shows the average deviation found between the interpolated 
result and the true value from the original function, while Table IT gives the aver- 
age discontinuity of the second derivative at the nodes. The data used for the in- 
terpolations were generated for the following 18 unequally spaced values of z: 
—2.95, —2.6, —2.1, —1.8, —1.4, —1.0, —0.75, —0.8, —0.05, 0.2, 0.55, 0.9, 1.25, 
1.6, 1.7, 2.1, 2.4, 3.0. 

The first three methods are nonlocal ones: Aitken’s rnethod and two cubic spline 
methods. The first of the two cubic splines (a) is as implemented in Spith [7] and 
is probably the most used of the spline routines in the NAG Library [5], while the 
second cubic spline (b) was implemented by Reid [6]. They differ mainly in their 
treatment of the end intervals: Spath sets the second derivative at the endpoints 
to zero; Reid forces the third derivative at the points adjacent to the ends to be 
continuous. The second three methods given in Table I are local ones: Akima’s, 
Maude’s, and the method described below. 

Our method is implemented in the two procedures described here. For each point 
(x; , yi) the first procedure, find gradients at nodes, initially finds that cubic poly- 


Table I. Average Deviation from Original Function for Various 
Interpolation Methods (X10®) 
Method 
Nonlocal Local 


Cubic splines 


Function Aitken’s (a) (b)  Akima’s Maude’s Present 
x2 0 28051 0 25709 8172 0 
x 0 165921 4561 112169 68566 6434 
en27/2 36 164 76 1260 640 78 
tanh x 10409 140 147 833 619 214 


sin x 0* 297 116 1531 1055 176 


* The actual value was 0.011 (<10-*). Aitken’s method gives a re- 
markably accurate fit for sin x and a remarkably poor one for tanh <. 


Table II. Average Discontinuity of Second Derivative 
at Data Points (10+) 


i a i He, 


Method 
All non- 
local 
methods Local 
as in 


Function Table I Akima’s Maude’s' Present 


x 0 79953 0 0 
a! 0 391953 0 5766 
en22 0 5027 0 268 
tanh x 0 4844 0 469 
sin x 0 6293 0 198 
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nomial which passes through the three points (ai-1, yi1), (ti, Yi), (itr, Yi) 
and which gives a least squares fit to the two neighboring data points (xi-2 , yi-z), 
(ti+2, Yir2). AS written, in the least squares fitting the weights given to the last 
two points are not equal, but are inversely proportional to the squares of their 
distances from 2;-1 and x;41 , respectively; we have found experimentally that such 
weighting leads to smaller discontinuities. in the second derivatives at the nodes. 
The gradient of this cubic at the central point (2; , y;) is then calculated. This 
process is repeated for all the points (x; , y:), except for the first two and the last 
two data points for which the subscripts x;_2 etc. or %42 etc. would be out of range; 
for these extreme points a cubic is fitted exactly through the first four or the last 
four points as appropriate. 

The second procedure, coeffs, then constructs as the approximating function for 
the interval x; < « < 2:4 that cubic polynomial which has the correct ordinates 
y: and Yiz1 and the calculated gradients at the two endpoints. The procedure 
calculates the four coefficients co, c1, C2, cs for which the approximating poly- 
nomial may be expressed in the form 

f(t) = a@+a(% — a) + (2 — ai)’ + o2(x — 2)’. 
This is preferred to the form ao + az + a2z” + asx° which is more unstable against 
roundoff errors. 

Normally the procedure find gradients at nodes need only be called once for any 
given set of x; , y; , thus avoiding unnecessary repetition of calculation; the gradients 
it calculates are then used by the procedure coeffs for any required interval. 

We have also found the method useful in two-dimensional interpolation to fit 
a surface z = f(z, y) through data on a rectangular grid (a; , y;, 2:;). This may 
be achieved by first applying the method to all the rows of data, keeping y; fixed 
and varying 2, and then by applying it again to the resulting four sets of coeffi- 
cients, but this time keeping «; fixed and varying j. 
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procedure find gradients at nodes (x,y,grad,1lbx,ubx); 
value lbx,ubx; integer lbx,ubx; 
array X,y,erad; 

comment x and y are arrays with subscripts from lbx 
to ubx giving the abscissae and ordinates respec— 
tively of the data points. These should be in 
ascending order of abscissae, with no two abscissae 
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equal. The arrays must contain at least four 
points. 
grad is an array having the same subscripts as x 
and y into which will be placed the calculated 
gradients of the required cubics at each of the 
data points. 
lbx and ubx are integers giving the minimum and 
maximum values respectively of the subscripts of 
the arrays xX, y, and grad; 
begin 
integer i,iless2,ilessi,iplusi,iplus2; 
real x0,x1,x2,x3,x4,y2,prod1,prod2,num,denom,g, 
coeff2,xdiff,xprod, weight; 
for is= lbx step 1 until ubx do 
begin 
comment special treatment is needed at end points; 
ilessl:= if 1>1bx then i-1 else i+3; 
iplust:= if i<ubx then i+1 else i-3; 
x2:= xfi]; _y2t= yLil; 
x1:= x{ iless1 |—x2; x33:= x{ iplus1 |—x2; 
comment first fit a quadratic through x1,x2,x3; 
prodt:= (yf iless1]-y2)*x3; 
prod2:= (y{ iplus1 |-y2)«x1; 
denom:= x1*xx3x(x{ iless1]—x[ iplus1]); 
ess (x1* prod2—x3xprod1) denom; 
coeff2:= (prod1—prod2) /denom; 
comment if xO exists, find its contribution to the 
cubic adjustment; 
if igJlbx+1 then num:= denom:= 0.0 else 
begin 
iless2:= i-2; xO:= x{ iless2|—x2; 
xdiff:= x{ iless2]~x[ iless1]; 
xprod:= xOxxdiffx(x[ iless2|-x{ iplus1]); 
weight:= xprod/(xdiffxxdiff); 
numi= weightx(yf iless2]—-y2—x0x(g+x0xcoeff2)); 
denom:= weightxxprod 
end ; 
comment if x4 exists, find its contribution to the 
cubic adjustment; 
if i<ubx=—1 then 
begin 
iplus2:= i+2; x4:= x{ iplus2]~x2; 
xdiff:= xf iplus2]—x[iplus1]; 
xprod:= x4xxdiffx(x[ iplus2]—x/ iless1]); 
weight:= xprod/(xdiffxxdiff) ; 
numi= num-weightx(y[ iplus2]—y2—x4x(g+x4xcoeff2) ) ; 
denom:= denomt+weightxxprod 
end; 
erad[ i]:= g+numxx1xx3/denom 
end 
end of procedure find gradients at nodes} 


procedure coeffs(x,y,grad,i,cO,c1,0c2,c3); 
value i; integer i; 
real c0,c1,c¢2,¢3; 
array X,y,grad; 
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comment This procedure calculates the coefficients 
of the cubic which has values y[i], y[i+1] and 
gradients grad [i], grad[i+1] at xfi], x[i+1] 
respectively. 
The cubic takes the form 

cO + clx(x—xfi]) + c2x(x—x[i])t2 + c3x(x-x[i])t3. 

To interpolate as suggested in the Description, 
above, these coefficients would be used for 
values of x in the range x i]<xex{ i+1]; 

begin 
real h,dy; 
ce yy ails 
he= xf it+1|—x[ i]; dy:= yl it+1]—c0; 
cl:= grad[ i]; 
c2t= (3.0xdy—hx(2.0xc1+grad[ i+1]))/(hxh); 
c3:= (hx(cltgrad[ it+1])-2.0xdy) /nt3 

end of procedure coeffs; 
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ALGORITHM 515 
Generation of a Vector 
from the Lexicographical Index [G6] 


B. P. BUCKLES AND M. LYBANON 
Computer Sciences Corporation 


Key Words and Phrases: combinations 
CR Categories: 5.39 
Language: Fortran 


DESCRIPTION 


Let C = {C1, Co,..., Cm} be the set of combinations of items taken p at a 
time and arranged in lexicographical order. Given an integer, 7 (1 < i < m, 
n = p > 0), the algorithm derives C;. Previous algorithms [1, 3, 6] have accom- 
plished this by the generation of all vectors between an initial point in the combina- 
tion space and the desired vector. The cited algorithms are computationally ad- 
vantageous if all combinations or a sequential subset are required. However, the 
algorithm given here is advantageous if a few randomly selected combinations 
are necded and each selection is not based on the previous selection history. 

A one-to-one correspondence between the universe of n items and the first n 
natural numbers is established. The combinations produced by the algorithm are 
selections of p of the first n integers in lexicographical order [2, 5]. Thus the com- 
binations produced by the algorithm may be regarded equivalently as pointers to 
combinations of any objects. If the combinations are generated sequentially (ac- 
cording to the index), exactly the same order is achieved as that of Mifsud’s al- 
gorithm [4]. 

Vector generation is performed by probing the combination space and sequent- 
ially reducing the interval of uncertainty within which the indexed vector resides. 
Beginning with the leftmost vector position, trial values in ascending order for the 
digits are tested by computing the index of the (partial) trial vector, using essen- 
tially the method of Walter [7]. The lexicographical index, 7, for a combination 
C; is computed as follows: Let the elements of the combination vector be de- 
noted Xi, X2,..., X,. Using Xo = 0, the index 7 is 


cc 
» (9-3) if Xp. +15 X;-1 
P=14+ 2°05; Q) = fee 7” = 

j=1 


0 otherwise. 
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This formula is the inverse of the present algorithm. The technique consists of 
accumulating terms of the form of thosc in the expression for Q; until a total greater 
than or equal to the desired vector index is reached. The value causing this condi- 
tion is X;. The sum is reduced by the amount of the last term (so that Q; only 
contains terms through X; — 1) and the search resumes at the next position to the 
right. The probing halts when there are no positions remaining. A previous ACM 
algorithm [8] is used to compute the binomial coefficients. 

Once a value has been eliminated from a position, it is eliminated from all follow- 
ing positions since the values are produced in ascending order. Thus the number 
of probes required to find a vector is exactly the numeric value of the last element. 
That is, the vector {1, 3, 7} will be found in seven probes given any combination 
space containing seven or more things taken three at a time. This leads to an ex- 
pression for the average number of probes required to find a vector based entirely 
on the frequency of values occurring as the last element: 


GAD CFS") (m= mm), 


It can be seen that each nonzero term in Q, (i.e. Q; fer 7 = p) equals unity. If 
the first term (1) in the expression for 7 is combined with Q, , it can be written 
in the form 


Q, = X;- Xp. 


Taking advantage of this identity, an improvement in performance may be 
obtained by computing 


Cp = pe an ae tear 


where L and K are variables given within the algorithm. 
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ALGORITHM 

SUBROUTINE COMB(N, P, L, C) CoM 61¢ 
C THIS SUBROUTINE FINDS THE COMBINATION SET OF N THINGS COM =s-_20 
C TAKEN P AT A TIME FOR A GIVEN LEXICOGRAPHICAL INDEX. COM 30 
C N - NUMBER OF THINGS IN THE SET CoM 6 4@ 
C P — NUMBER OF THINGS IN EACH COMBINATION COM 50 
C L - LEXICOGRAPHICAL INDEX OF COMBINATION SOUGHT COM 669 
C C - OUTPUT ARRAY CONTAINING THE COMBINATION SET COM 76 


COLLECTED ALGORITHMS (cont.) 


C THE 
C 
C 
C 


FOLLOWING RELATIONSHIPS MUST EXIST AMONG THE INPUT 


VARIABLES. L MUST BE GREATER THAN OR EQUAL TO 1 AND LESS 
THAN OR EQUAL TO THE MAXIMUM LEXICOGRAPHICAL INDEX. 
P MUST BE LESS THAN OR EQUAL TO N AND GREATER THAN ZERO. 


INTEGER N, P, L, C(P), K, R, Pl, BINOM 


C INITIALIZE LOWER BOUND INDEX AT ZERO 


K=@ 


C LOOP TO SELECT ELEMENTS IN ASCENDING ORDER 


C SET 


Pl=P-1 

DO 2@ I=1,P1 

LOWER BOUND ELEMENT NUMBER FOR NEXT ELEMENT VALUE 
C(I) = @ 
IF (1.NE.1) C(I) = C(I-1) 


C LOOP TO CHECK VALIDITY OF EACH ELEMENT VALUE 


10 


20 


Cc ACM 


C(I) = c(1) +1 
R = BINOM(N-C(1),P-I) 
K=K+R 
IF (K.LT.L) GO TO 19 
Ke k= 'R 
CONTINUE 
c(P) = C(Pl) +L-K 
RETURN 
END 


INTEGER FUNCTION BINOM(M, N) 
ALGORITHM 16@ TRANSLATED TO FORTRAN. CALCULATES THE 


C NUMBER OF COMBINATIONS OF M THINGS TAKEN N AT A TIME. 


1 


20 
3¢ 


INTEGER M, N, P, I, Nl, R 


Nl =N 

P=M-Nl 

IF (N1.GE.P) GO TO 1¢ 
P =Nl 

Nl =M-P 

R=NI +1 


IF (P.EQ.¢) R = 1 
IF (P.LT.2) GO TO 3¢ 
DO 2 I=2,P 
R = (R*(N14I))/1 
CONTINUE 
BINOM = R 
RETURN 
END 
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COM 
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COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
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ALGORITHM 516 

An Algorithm for Obtaining Confidence 
Intervals and Point Estimates Based on Ranks 
in the Two-Sample Location Problem [G1] 


J. W. McKEAN and T. A. RYAN, JR. 
Pennsylvania State University 


Key Words and Phrases: asymptotic linearity, confidence interval, Illinois method, point 
estimate, ranks, regula falsi, robust, Wilcoxon-Mann-Whitney rank test 

CR Categories: 5.5 

Language: Fortran 


DESCRIPTION 


Suppose we are sampling from two populations which have the same continuous 
distribution except for a possible shift in location. For notational convenience let 
X1,..., Xm be a random sample from F(x) and let Y1,..., Yn be a random 
sample from F(x — 6). In testing hypotheses concerning 6 the robust two-sample 
rank test (Wilcoxon-Mann-Whitney) is often used, but the related point estimate 
and confidence intervals are used relatively rarely. The reasons for this are pri- 
marily computational. While it has been practical to carry out the test for large 
sample sizes, it has not been practical for the estimates. 

The most common method for computing the estimates is based on the m:n 
ordered differences D:; = Y; — X; (for instance, see Noether [5, p. 188]). These 
differences can be quickly obtained and ordered for small m and n; however, for 
large m and n they may be costly to obtain, even with the use of a computer. The 
storage is high (for example, if m and 7 are 1000, then 1,000,000 words of storage 
are needed); furthermore, computation time is high (of order m-n, even if the 
samples are ordered in a preliminary step). 

One way of avoiding the computation difficulty is to modify the estimate, for 
instance, as Antille [1] did in one sample problem. We propose instead an itera- 
tion procedure based on the function U(@) = #(Y; — Xi < 6). This is the Mann- 
Whitney test statistic for testing that the shift is 6; it differs only by a constant 
from the Wilcoxon rank sum statistic. It is an increasing function of 6 which steps 
up one unit at each difference Y; — X;. The point estimate and confidence in- 
terval can be found by essentially inverting this function; for example, the point 
estimate of 6 is 6 = median (D;;), which can be found by solving the equation 
U(@) = mn/2 (the middle such value if it is not unique). The endpoints of the 


Received 22 August 1975 and 10 May 1976. 

Copyright © 1977, Association for Computing Machinery, Inc. General permission to repub- 
lish, but not for profit, all or part of this material is granted provided that ACM’s copyright 
notice is given and that reference is made to the publication, to its date of issue, and to the 
fact that reprinting privileges were granted by permission of the Association for Computing 
Machinery. 

Authors’ present addresses: J.W. McKean, Department of Mathematical Sciences, University 
of Texas at Dallas, 2601 N. Floyd Rd., Richardson, TX 75080; T.A. Ryan, Jr., Department of 
Statistics, College of Science, Pennsylvania State University, 219 Pond Laboratory; University 
Park, PA 16802. 


ACM Transactions on Mathematical Software, Vol. 3, No. 2, June 1977, Pages 183-185. 


COLLECTED ALGORITHMS (cont.) 516-P 2- 0 


confidence interval can be obtained similarly. Sec Hettmansperger and McKean 
[3] for a graphical view of U(6). 

The algorithm given here finds the point estimate and confidence interval by 
solving such equations. Since U(@) is monotone, methods such as regula falsi 
(linear interpolation) may be used. Of the methods tried, we have found the Illinois 
method, a modification of the regula falsi method outlined by Dowell and Jarratt 
[2], to be the best. The number of iterations is reduced by a factor of 2 or 3 when 
it is compared to regula falsi; hence we have incorporated it into the algorithm. 
The algorithm requires a preliminary and scparate ordering of the X and Y. We 
have found that this ordering allows an algorithm for calculating U(6@) which saves 
a considerable amount of time. 

The algorithm eliminates the storage problem. Furthermore, we feel the al- 
gorithm obtains the estimates quickly cnough to make them more attractive. 
The time for an evaluation of U(@) is linear in sample size but the number of itera- 
tions decreases due to the asymptotic linearity of U(@) (sec Jureckova [4]). For 
example, in a test run with m = 1000 and n = 1200 the computation time was 
0.19 CPU seconds to obtain both the point estimate and confidence interval on 
an IBM 370 Model 168 (this costs about $0.02). 
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ALGORITHM 
SUBROUTINE RANKCI(X, M, Y, N, PERC, DPOINT, DLOW, DHIGH, RAN 1 
* IERR, ILOW, IHIGH) RAN 26 
C SUBROUTINE TO FIND THE POINT ESTIMATE AND CONFIDENCE INTERVAL RAN 36 
C RELATED TO THE TWO-SAMPLE RANK TEST (MANN-WHITNEY, WILCOXON), RAN 40 
C FOR THE PARAMETER D = MU(Y) - MU(X), WHERE MU IS A MEASURE OF RAN 5¢ 
C LOCATION. RAN 60 
C THE STATISTICAL ASSUMPTIONS ARE THAT X AND Y ARE RANDOM SAMPLES RAN 7¢ 
C TAKEN INDEPENDENTLY FROM TWO DIFFERENT POPULATIONS, AND THAT RAN 80 
C THE POPULATIONS HAVE THE SAME DISTRIBUTION EXCEPT FOR LOCATION. RAN 90 
C IN PARTICULAR, IT IS ASSUMED THAT THE SCALE PARAMETERS (VARIANCES, RAN 160 
C IF THEY EXIST) ARE EQUAL. RAN 116 
C THIS ROUTINE FINDS THE POINT ESTIMATE FOR D AS THAT VALUE DPOINT RAN 126 
C SUCH THAT THE MANN-WHITNEY U STATISTIC ACHIEVES LTS EXPECTED RAN 130 
C VALUE FOR THE TEST OF THE NULL HYPOTHESIS D = DPOINT (THE MIDDLE RAN 14¢ 
C SUCH VALUE IF IT IS NOT UNIQUE). RAN 150 
C THE CONFIDENCE INTERVAL IS FOUND AS THOSE VALUES OF DD SUCH THAT RAN 16¢ 
C THE NULL HYPOTHESLS D = DD IS NOT REJECTED BY THE TWO SAMPLE RANK RAN 170 
Go TEST, RAN 18@ 
C THE METHOD OF CALCULATING THE TEST STATISTIC U IS THE ORIGINAL RAN 190 
C METHOD OF MANN AND WHITNEY, MODIFIED TO TAKE ADVANTAGE OF HAVING RAN 200 
C THE DATA IN ORDER. THIS SPEEDS CALCULATIONS CONSIDERABLY, WHICH RAN 21¢ 
C IS IMPORTANT SINCE THE METHODS USED MUST EVALUATE THE STATISTIC RAN 220 
C REPEATEDLY. RAN 230 
C THE POINT AND CONFIDENCE INTERVALS ARE FOUND BY ITERATION, USING RAN 240 
C TRIMMED MEANS AS STARTING POINTS. THE BASIC ITERATION PROCEDURE RAN 250 
C IS A MODIFICATION OF THE REGULA FALSI (LINEAR INTERPOLATION) RAN 260 
C METHOD, (DOWELL + JARRATT, 1971,BIT) WHICH CONVERGES QUICKLY RAN 270 
C BECAUSE OF THE ASYMTOTIC LINEARITY OF THE U STATISTIC AS A RAN 286 
C FUNCTION OF D (JURECKOVA, 1971, ANN. MATH. STAT.). RAN 296 
C THE PERCENTAGE OF THE CONFIDENCE INTERVAL IS OBTAZNED BY A NORMAL RAN 360 
C APPROXIMATION, USING CONTINUITY CORRECTION. RAN 310 
C INPUT IS AS FOLLOWS RAN 326 
Cc X ~ ARRAY OF DATA OF DIMENSION M IN NON-DECREASING ORDER RAN 33¢ 
G M - NUMBER OF OBSERVATIONS IN X SAMPLE (AT LEAST 2) RAN 34¢ 
C Y ~ ARRAY OF DATA OF DIMENSION N IN NON-DECREASING ORDER RAN 356 
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C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
Cc 
C 
C 


(o 


a 


OOo raaqnaanc 


ono 


(po @ ie? ae 


N ~ NUMBER OF OBSERVATIONS IN Y SAMPLE (AT LEAST 2) 
(X,M,Y,AND N ARE UNCHANGED) 

PERC - DESIRED CONFIDENCE PERCENT (BETWEEN 49.999 AND 99.999) 
(PERC IS CHANGED TO THE NEAREST ATTAINABLE CONFIDENCE) 


OUTPUT 


IS AS FOLLOWS 


IERR = @ IF NORMAL COMPLETION 


1 IF TOO LITTLE DATA (M OR N LESS THAN 2) 


2 IF INVALID PERCENTAGE 
3 IF DATA IS NOT IN ORDER 
PERC — ACTUAL (APPROX.) CONFIDENCE OF THE INTERVAL 
DPOINT -— POINT ESTIMATE OF D 
DLOW - LOWER CONFIDENCE LIMIT FOR D 
ILOW - THE ORDER OF THE DIFFERENCE DLOW 
DHIGH - UPPER CONFIDENCE LIMIT FOR D 
IHIGH - THE ORDER OF THE DIFFERENCE DHIGH 
WRITTEN JUNE 1975 BY T. RYAN AND J. MCKEAN 
DIMENSION X(M), Y(N) 
INITIALIZE 
DPOINT = ¢.6 
DLOW = @.¢@ 
DHIGH = @.¢@ 
IERR = ¢ 
XM = M 
XN = N 
ERROR CHECKING 
CALL CHECK(X, M, Y, N, PERC, IERR) 


IF ( 


IERR.GT.@) RETURN 


REEKERERERERKRRRERERKE RE RERRRERRERRER RE REREREREREREERRRRRERERERERERERRRERERAN 


CALL 
CALL 


PRELIMINARY ESTIMATE 
TMEAN(X, M, XBAR, VARXB) 
TMEAN(Y, N, YBAR, VARYB) 


D = YBAR - XBAR 


V = VARXB + VARYB 
SD = SQRT(V) 

SD = AMAX1(SD,1.@E-20) 

T = 2.9 

IF (M.LT.1@ .OR. N.LT.1@ .OR. PERC.GT.96.0) T = 3.0 
DL = D - T*SD 

DH = D + T*SD 


RAN 


HARKER RIK RIKER ERR ERE ERERRERERRERRERREREE RRR ERR RRRERERAN 


DEFINE TOLERANCES EPS1 AND EPS2. THESE 
TOLERANCES WERE SELECTED FOR IBM 364-376 
ACCURACY, APPROXIMATELY 6.5 DECIMAL PLACES. 
DEPENDING ON MACHINE BEING USED AND WHETHER 
DATA WARRANTS SUCH PRECISION, THE TOLERANCE 
MAY BE LOWERED. 


BASE TOLERANCE ON RANGE OF DATA 

Z = X(M) - X(1) 

ZZ = Y(N) — Y(1) 

EPS1 = (1.Q@E-7)*AMAXI1 (Z,ZZ) 
BASE TOLERANCE ON THE MAGNITUDE OF THE DATA 

K = M/2 

Z = X(K) 

K = N/2 

ZZ = Y(K) 

EPS2 = (1.Q@E-6)*AMAX1(Z,-Z,ZZ,-ZZ) 

EPS1 = AMAX1(EPS1,EPS2) 
BASE TOLERANCE ON WIDTH OF CONFIDENCE INTERVAL 
(BASED ON PRELIMINARY ESTIMATES). THE POINT 
ESTIMATE SHOULD BE ACCURATE TO 4 SIG. DIGITS IN 
THE WIDTH (APPROX.). 

EPS2 = SD*4.@E-4 

EPS1 = AMAX1(EPS1,EPS2) 
MAXIMUM ACCURACY SET TO 1.E-2@¢ 

EPS1 = AMAX1(EPS1,1.@E-20) 
ONE LESS SIGNIFICANT DIGIT IN END POINTS OF 
THE CONFIDENCE INTERVAL THAN THE POINT ESTIMATE. 

EPS2 = 106.@*EPS1 


RAN 
RAN 


RHR RARE REE RE RRR RE RR RRER ERR ER ERERERERERRER RRR ERRERRRE NER RRRER ERAN 


GET CRITICAL VALUES OF THE U STATISTIC 
ODD OR EVEN M*N DETERMINES HOW POINT ESTIMATE 
IS CALCULATED 


IODD = 1 

IF (MOD (M*N,2).EQ.@) GO TO 16 
UMED1 = XM*XN/2.@ 

GO TO 20 
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OO CO 


CPs 12 


QD 


oa e 


16 


20 


UMED1 = XM*XN/2.@ - @.5 RAN 
UMED2 = UMED1 + 1.0 RAN 
IODD = @ RAN 
P IS ONE-TAILED PROB. RAN 

P = (100.Q@-PERC)/200.@ RAN 
FIND MEAN AND VARIANCE OF THE U-STATISTIC RAN 

FOR USE IN A NORMAL APPROXIMATION. RAN 

UMU = XM*XN/2.¢ RAN 
UVAR = XM*XN* (XM+XN+1.0)/12.@ RAN 
USIGMA = SQRT(UVAR) RAN 
NORMAL APPROX. (WITH CONTINUITY CORRECTION) IS RAN 

P = PHI ( (ULOW +.5 -UMU)/USIGMA ) RAN 

(WHERE PHI IS STANDARD NORMAL DIST. FUNCTION, RAN 

AND PHINV IS ITS INVERSE). RAN 

ULOW = USIGMA*PHINV(P) + UMU - @.5 RAN 
ROUND CRITICAL VALUE DOWN TO INTEGER RAN 

(THIS GIVES CONSERVATIVE BOUNDS), AND FIND P. RAN 

LU = ULOW RAN 
IF (IU.LT.@) IU = @ RAN 
ULOW = IU RAN 
Z = (ULOW+@.5-UMU) /USIGMA RAN 
P = PHI(Z) RAN 
PERC = 100.0*(1.@-2.0*P) RAN 
WANT TO INVERT FUNCTION U AT A HALF INTEGER RAN 

ULOW = ULOW + @.5 RAN 
UHIGH RAN 

UHIGH = XM*XN ~ ULOW RAN 
ILOW = ULOW + .5 RAN 
IHIGH = UHIGH + .5 RAN 
ILOW AND IHIGH GIVE THE ORDERED DIFFERENCES RAN 

WHICH FORM THE CONFIDENCE INTERVAL. RAN 

AN ESTIMATE OF THE SLOPE OF TH= LINEAR RAN 

APPROXIMATION TO FMANN. RAN 

SLOPE = (ABS (Z)*SQRT (XM*XN* (XM+XN) )) / ((DH—-DL) *SQRT(3.)) RAN 
X1 AND X2 BRACKET THE LOWER CONFIDENCE LIMIT. RAN 

THEN BY CALLING THE ROUTINE ILL THE LOWER CONFI- RAN 

DENCE LIMIT WITHIN EPS2 IS RETURNED VIA DLOW. RAN 

CALL BRACK(DL, ULOW, SLOPE, X, M, Y, N, Xl, FX1, X2, FX2) RAN 
CALL ILL(DLOW, ULOW, X1, FX1, X2, FX2, X, M, Y, N, EPS2) RAN 
SAME FOR UPPER END VIA DHIGH. RAN 

CALL BRACK(DH, UHIGH, SLOPE, X, M, Y, N, Xl, FX1, X2, FX2) RAN 
CALL ILL(DHIGH, UHIGH, Xl, FX1, X2, FX2, X, M, Y, N, EPS2) RAN 
A NEW ESTIMATE OF SLOPE BASED ON THE CONFIDENCE RAN 

INTERVAL (DLOW,DHIGH), UNLESS. THE LENGTH OF RAN 

THE INTERVAL IS SMALLER THAN EPS2. RAN 

IF (DHIGH.GT.DLOW+EPS2) SLOPE = ((DH-DL) /(DHIGH-DLOW) )*SLOPE RAN 
THE SAME ROUTINES ARE USED FOR THE ESTIMATE RAN 

DPOINT EXCEPT EPS1 IS USED. THE MIDPOINT RAN 

OF THE CONFIDENCE INTERVAL WILL BE THE INITIAL RAN 

ESTIMATE OF DPOINT. RAN 

D = (DLOW+DHIGH)/2.¢@ RAN 
CALL BRACK(D, UMED1, SLOPE, X, M, Y, N, Xl, FX1, X2, FX2) RAN 
CALL ILL(DPOINT, UMED1, Xl, FX1, X2, FX2, X, M, Y, N, EPS1) RAN 
IF M4N IS ODD THE ESTIMATE IS DPOINT, RAN 

IF (IODD.EQ.1) RETURN RAN 
IF EVEN THEN THE VALUE DPOINT IS THE LOWER RAN 


CENTER ESTIMATE. THE UPPER CENTER ESTIMATE IS D2,RAN 
AND THE FINAL ESTIMATE IS THE AVERAGE OF THE TWO.RAN 
CALL BRACK(DPOINT, UMED2, SLOPE, X, M, Y, N, Xl, FX1, X2, FX2) RAN 


CALL ILL(D2, UMED2, Xl, FX1, X2, FX2, X, M, Y, N, EPS1) RAN 
DPOINT = (DPOINT+D2)/2. RAN 
RETURN RAN 
END RAN 
SUBROUTINE CHECK(X, M, Y, N, PERC, IERR) CHE 
SUBROUTINE TO DO ERROR CHECKING FOR RANKCI CHE 
WRITTEN JUNE 1975 BY T. RYAN CHE 
DIMENSION X(M), Y(N) CHE 
CHECK FOR INSUFFICIENT DATA CHE 

IF (M.GE.2 .AND. N.GE.2) GO TO 10 CHE 
IERR = 1 CHE 
RETURN CHE 
CHECK FOR PROPER PERCENT CONFIDENCE CHE 

1@ IF (PERC.LT.99.999 .AND. PERC.GT.49.999) GO TO 20 CHE 
IERR = 2 CHE 
RETURN CHE 
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C 
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CHECK FOR X AND Y ARRAYS IN NON-DECREASING ORDERCHE 


20 DO 3@ I=2,M 
IF (X(I-1).GT.X(1I)) GO TO 50 
3@ CONTINUE 
DO 4@ I=2,N 
IF (Y(I-1).GT.Y(1)) GO TO 5¢ 
4@ CONTINUE 
RETURN 
X OR Y ARRAY OUT OF ORDER 
5@ IERR = 3 
RETURN 
END 


SUBROUTINE TMEAN(Z, N, ZBAR, VARZB) 
GIVEN DATA Z(1), Z(2), ..., Z(N) IN NON-DECREASING ORDER, 
THIS ROUTINE FINDS THE ALPHA-TRIMMED MEAN ZBAR, AND THE 
ESTIMATED VARIANCE OF ZBAR, VARZB. 
WRITTEN JUNE 1975 BY T. RYAN 


DIMENSION Z(N) 
DATA ALPHA /@.16/ 
XN = N 
NT IS NUMBER TRIMMED FROM EACH END 
Nl IS NUMBER OF LOWEST OBSERVATION NOT TRIMMED 
N2 IS NUMBER OF HIGHEST OBSERVATION NOT TRIMMED 
NT = ALPHA*XN 
Nl = NT +1 
N2 = N - NT 
TRIMMED MEAN 
SUM = ¢.@ 


DO 19 I=N1,N2 
SUM = SUM + Z(I) 
19 CONTINUE 
X = N - 24NT 
ZBAR = SUM/X 
WINSORIZED SUM OF SQUARES 
SUM = 9.@ 
DO 2@ I=N1,N2 
SUM = SUM + (Z(I)-ZBAR)**2 
2@ CONTINUE 
IF (NT.EQ.¢) GO TO 3¢ 
XNT = NT 
SUM = SUM + XNT*(Z(N1-1)-ZBAR)**2 + XNT*(Z(N2+1)-ZBAR)**2 
3@ VARZB = SUM/(XN*XN) 
RETURN 
END 


SUBROUTINE ILL(XVAL, FVAL, Xl, Fl, X2, F2, X, M, Y, N, EPS) 
THIS ROUTINE SOLVES THE EQUATION 
F(T)-FVAL=0@ 
FOR A MONOTONE FUNCTION F, IN THIS INSTANCE FMANN. THE METHOD 
USED IS THE ILLINOIS METHOD AS DESCRIBED BY DOWELL AND JARRATT 
(1971,BIT), EXCEPT FOR A MODIFICATION WHEN CLOSE TO THE ROOT. 
THEN IF THE ROOT WAS NOT TRAPPED ON THE LAST ITERATION THE ROU- 
TINE SWITCHES TO THE BISECTION METHOD. 
INPUT - 
FVAL = THE VALUE OF THE FUNCTION AT THE ROOT. 
X1 AND X2 ARE VALUES WHICH BRACKET THE ROOT, THAT IS 


EITHER 

F(X1) .LT. FVAL .LT. F(X2) 
OR 

F(X2) .LT. FVAL .LT. F(X1) 
FX1 = F(X1) 
FX2 = F(X2) 


X, M, Y, AND N ARE QUANTITIES USED BY THE FUNCTION FMANN 
EPS = THE ACCURACY OF THE SOLUTION. 
X1, X2, AND THEIR FUNCTIONAL VALUES ARE CHANGED THROUGHOUT THE 
ROUTINE. 
OUTPUT - 
XVAL = THE ROOT WITHIN EPS. 
DIMENSION X(M), Y(N) 
Fl = Fl - FVAL 
F2 = F2 - FVAL 
IBISEC = @ 
1¢@ CONTINUE 
IF (ABS(X2-X1).LT.EPS) GO TO 4@¢ 


CHE 
CHE 
CHE 
CHE 
CHE 
CHE 
CHE 
CHE 
CHE 
CHE 
CHE 
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X3 IS THE INTERSECTION OF THE SECANT LINE 
FORMED BY (X1,F1), (X2,F2) AND THE X-AXIS. 

X3 = X2 - (F2*(X2-X1))/(F2-F1) 

IF (IBISEC.EQ.1) X3 = (X1+X2)/2. 

IBISEC = @ 

CALL FMANN(X3, X, M, Y, N, F3) 

F3 = F3 - FVAL 

IF (F3*F2) 26, 2@, 30 


ROOT WAS TRAPPED, SO USE REGULA FALSI 
2@ X1 = X2 
Fl = F2 
X2 = X3 
F2 = F3 
GO TO 10 
ROOT WAS NOT TRAPPED, SO USE ILLINOIS MOD- 
IFICATION. 
30 X2 = X3 
F2 = F3 
Fl = F1/2. 


IF (ABS(F2).LE.ABS(Fl1)) GO TO 1¢ 
IF ILLINOIS MODIFICATION IS MORE RADICAL 
THAN BISECTION, THEN USE BISECTION. 

Fl = 2.Q*F1L 

IBISEC = 1 

GO TO 10 

4@ XVAL = (X1+X2)/2. 
RETURN 
END 


SUBROUTINE BRACK(XINIT, FVAL, SLOPE, X, M, Y, N, Xl, FX1, X2, 
* FX2) 
SUPPOSE THE FUNCTION F IS MONOTONE AND IT IS DESIRED TO SOLVE 
THE EQUATION 
F(T) - FVAL = @. 
THIS ROUTINE RETURNS TWO VALUES WHICH BRACKET THE ROOT. 
INPUT - 
XINIT = INITIAL ESTIMATE OF THE ROOT. 
FVAL = THE VALUE OF THE FUNCTION AT THE ROOT. 
SLOPE = APPROXIMATE SLOPE OF THE FUNCTION IN A 
NEIGHBORHOOD OF THE ROOT. 
X, M, Y, AND N ARE QUANTITIES USED BY THE FUNCTION WHICH 
IN THIS INSTANCE IS FMANN. 
NONE OF THE ABOVE QUANTITIES IS CHANGED THROUGHOUT THIS ROUTINE 
OUTPUT - 


X1 AND X2 BRACKET THE ROOT, THAT IS EITHER 
F(X1) .LT. FVAL .LT. F(X2) 
OR 
F(X2) .LT. FVAL .LT. F(X1) 
FX1 = F(X1) 
FX2 = F(X2) 
DIMENSION X(M), Y(N) 
Xl = XINIT 


CALL FMANN(X1, X, M, Y, N, FX1) 
DELTA = 1.5*((FVAL-FX1) /SLOPE) 
10 X2 = Xl + DELTA 


CALL FMANN(X2, X, M, Y, N, FX2) 

IF ((FX1-FVAL)* (FX2-FVAL) .LT.@.) RETURN 
X1 = X2 

GO TO 10 

END 


SUBROUTINE FMANN(D, X, MM, Y, NN, U) 
ROUTINE TO CALCULATE THE MANN-WHITNEY STATISTIC U. 
U DIFFERS ONLY BY A CONSTANT FROM THE WILCOXON 2-SAMPLE RANK 
STATISTIC W. 
INPUT - 
D = NULL HYPOTHESIS VALUE OF THE SHIFT OF THE Y 
POPULATION FROM THE X POPULATION (I.E. THE NULL 
HYPOTHESIS BEING TESTED IS MU(Y) = MU(X) + D). 
X = ARRAY CONTAINING THE SAMPLE FROM ONE POPULATION, 
WHICH MUST BE IN NON-DECREASING ORDER. 
M = DIMENSION (SAMPLE SIZE) OF X 
Y = ARRAY CONTAINING THE SAMPLE FROM THE OTHER POPULATION, 
WHICH MUST BE IN NON-DECREASING ORDER. 
N = DIMENSION (SAMPLE SIZE) OF Y 
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NONE OF THE ABOVE IS ALTERED BY THIS ROUTINE. 
OUTPUT - 
U = MANN-WHITNEY TEST STATISTIC. 
THIS ROUTINE IS INTENDED TO BE USED IN AN ITERATION ROUTINE FOR 


ESTIMATION ONLY, SINCE NO CHECKS OR ADJUSTMENTS ARE MADE FOR TIES. 


THIS ROUTINE IS DESIGNED TO BE VERY FAST, SINCE IT IS TO BE USED 

IN AN ITERATION PROCEDURE, SO NO CHECKS ARE MADE TO INSURE THAT 

M AND N ARE POSITIVE, OR THAT X AND Y ARE NON-DECREASING. 

ALL CHECKING SHOULD BE DONE IN CALLING PROGRAM. 

U= SUM (NO. OF Y(J) LESS THAN (OR EQUAL) TO X(1I)+DELTA) WHERE 

THE SUM IS OVER I. 

SINCE ARRAYS X AND Y ARE ORDERED, IF X(I) IS GREATER THAN Y(J), 

X(I+1) MUST ALSO BE. 

WRITTEN 3/75 BY T. RYAN. LAST UPDATED 6/75 BY T. RYAN 
DIMENSION X(MM), Y(NN) 


DELTA = D 
M = MM 
N = NN 
JLE IS THE NUMBER OF Y VALUES LESS THAN OR 
EQUAL TO X(I). 
IU IS ACCUMULATED AS THE VALUE OF THE U 
STATISTIC. 
JLE = @ 
Iu = 6 
MAIN LOOP 
DO 3¢ I=1,M 


XI = X(1) + DELTA 
1@ IF (XI.LT.Y(JLE+1)) GO TO 20 
JLE = JLE + 1 
IF (JLE.GE.N) GO TO 5@ 
GO TO 1¢ 
26 IU = IU + JLE 
3@ CONTINUE 
49 U = IU 
RETURN 


X(I) IS GREATER THAN (OR EQUAL) TO ALL Y(J). 


THEREFORE X(I+1), ..., X(M) ARE ALL GREATER 
THAN ALL Y(J). 
5@ IU = IU + (M-I+1)*N 
GO TO 4¢ 
END 


FUNCTION PHINV(P) 
INVERSE NORMAL DISTRIBUTION FUNCTION. 
IF Z IS N(@,1), THIS FUNCTION RETURNS PHINV DEFINED BY 
P(A .LT. PHINV) = P, (9.0 .LT. P AND P .LT. 1.0). 
REF. HANDBOOK OF MATHEMATICAL FUNCTIONS , 1964, USDC, NATIONAL 
BUREAU OF STANDARDS, WASH. DC. P. 933, FORMULA 26.2.23. 
ERROR WILL BE LESS THAN 4.5E-@4. 
WRITTEN 4/76 BY T. RYAN BASED ON ROUTINE BY H. D. KNOBLE (1966). 
IF (P.LE.@. .OR. P.GE.1.0) GO TO 30 
IF (P.LT.@.5) GO TO 10 
SIGN = 1.0 
PTAIL = 1.6 - P 
GO TO 29 
1@ SIGN = -1.@ 
PTAIL = P 
2@ T = SQRT(ALOG(1.@/(PTAIL*PTAIL) ) ) 
Z = ABS (T-(2.515517+T* (@. 802853+T*O. 910328) )/(1.G+T* 
* (1.432788+T* (9. 189269+T*@. 001308) ))) 
PHINV = Z*SIGN 
RETURN 
36 CONTINUE 
RETURN 
END 


FUNCTION PHI (X) 
NORMAL DISTRIBUTION FUNCTION 
LET Z BE N(@,1), THEN PHI IS DEFINED BY PHI = P(Z .LE. X). 
REF. HANDBOOK OF MATHEMATICAL FUNCTIONS , 1964, USDC, NATIONAL 
BUREAU OF STANDARDS, WASH. DC, P. 933, FORMULA 26.2.19. 
ERROR IS LESS THAN 1.5E~@7. 


WRITTEN 4/76 BY T. RYAN, BASED ON ROUTINE BY H. D. KNOBLE (1966). 


Z=X 
IF (Z.LT.@.@) GO TO 1 
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ISIGN = 1 PHI 16¢ 

GO TO 29 PHI 110 

19 Z = -X PHI 120 
LSIGN = -1 PHI 13@ 

20 P = @.5*(1.G4+2* (6.6498673474+2Z% (@.02114160614+2Z*% (3.2776263D-3+Z* PHI 14¢ 
* (3.80036E-@5+Z* (4.889Q06E-05+Z*5 .383E-@6) )))))** (-16) PHI 15¢@ 
IF (ISIGN.EQ.1) P = 1.6 - P PHI 16@ 
PHI = P PHI 17¢ 
RETURN PHI 18¢ 


END PHI 19¢ 
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ALGORITHM 517 

A Program for Computing the Condition 
Numbers of Matrix Eigenvalues Without 
Computing Eigenvectors | F2 | 


S. P. CHAN, R. FELDMAN, and B. N. PARLETT 
University of California 


Key Words and Phrases: eigenvalue, condition number 
CR Categories: 5.14 
Language: Fortran 


DESCRIPTION 


1. Theoretical Background 


1.1 The Sensitivity of Eigenvalues. Several good programs are available for the 
computation of the eigenvalues of real and complex matrices [2, 3, 7]. Because of 
the limitations of finite precision arithmetic, these programs cannot produce, in 
general, the exact eigenvalues of the given matrix A. However the computed 
numbers are always (very close to) the eigenvalues of a matrix A + E which is 
very close to A. This matrix FE is not unique and error analyses [6] have shown the 
existence of H’s with satisfactorily small upper bounds on || £ || / || A ||. Here 
||- || denotes an appropriate matrix norm. 

It follows from these remarks that a good program will not always deliver ac- 
curate approximations to the eigenvalues of A. It can happen that some, or all, 
of the eigenvalues are very sensitive to changes in the matrix elements; so some, 
or all, of the eigenvalues of A + EH may differ sharply from those of A. Actually 
this is true only for non-normal matrices. Real symmetric matrices—indeed all 
normal matrices—determine their eigenvalues very well; the change induced in 
an eigenvalue of such an A cannot exceed the spectral norm of £ (which is defined 
below). 

Two questions arise: How can this sensitivity be measured, and how cheaply 
can it be computed? 

Simple eigenvalues. To any simple eigenvalue \ of A there correspond both a 
column vector z and a row eigenvector y* (the conjugate transpose of y) which 
are unique to within a scalar multiple. Thus 


Az = 2), yA = ry" (1) 
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and « = y if A is normal (ic. A*A = AA”). The most popular measure of the 
sensitivity of \ was called the spectral condition number cond () by Wilkinson 
[6]. Let @ denote the acute angle between x and y; then 


cond (x) = secant @ = || y||-|| 2] /|y*z| 
where 


ell = Vo"). (2) 


This definition gives a number in [1, ©) which increases monotonically with the 
sensitivity of \ to changes in A. 
In order to justify this definition two popular matrix norms will be used: 


| || = max | Mv | / oll = VOrmex(0"M)), 
(3) 
| M ||n = Vie 2, | mis ?) = (trace (M*M)). 


Let | 6\ | be the change in ) corresponding to a change 6A in A. It can be shown 
that 
cond (A) = sup | 6A | / || 6A [lz (4) 


over all non-null infinitesimal 6A. 

Another useful characterization of cond (\) is the following: The spectral pro- 
jector Py of \ is the matrix which projects every vector into a multiple of the eigen- 
vector of \. It is easy to verify that for simple \ 


Py = xy"/y"e (5) 
where y*z is a scalar, and by using the fact that P, is of rank 1, one can show that 
cond (A) = || Py lz = || Pall. (6) 


It is this characterization which can be generalized. 

Multiple eigenvalues. When d has geometric multiplicity m, almost all perturba- 
tions of A break ) into m simple eigenvalues in such a way that sup | 6A | / || 6A || 
is unbounded. Thus it is customary to set cond (A) = © in this case. 

There is more to be said however. A reasonable definition (see Kahan [4]) puts 


cond (A) = sup | 6A | / || 6A || (7) 


over all non-null infinitesimal 6A which preserve the multiplicity of \. This num- 
ber can be estimated because cond (A) < || Py ||z / m where the spectral projector 
P, satisfies AP, = P,A = dP, + N) and Nj is nilpotent (i.e. My" = 0). More- 
over P, can be found from the expression 


Py, = X(Y*X)"Y* (8) 


where the columns of X and rows of Y* arc bases for the invariant subspaces of }. 

We have followed the usual practice (of setting the condition number equal to 
infinity) in our program CONDIT but wish to point out that it is feasible to bring 
into adjacent positions on the diagonal of the Schur form any associated ill-con- 
ditioned eigenvalues. The spectral projector for this group of eigenvalues can then 
be found from (8), and if its norm is small, the group can be designated as a cluster. 
That is another project. 

If more specific information is required, then the individual elements of P, will 
be involved because 

O/da;; = e; Pye (9) 
with \ simple. 

A warning should be offered at this point. The measures presented above are 
based on the Euclidean vector norm and the convention that A acts on vectors in 
Euclidean n-space. It can happen that this model is quite inappropriate for certain 
applications and then the conventional condition numbers will be irrelevant. How- 
ever it is only the order of magnitude (base 10) of cond (A) which is wanted, in 
most cases, and this will be constant over a large range of norms. 
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1.2 Invariance Properties. When the role of the matrix is to be stressed the con- 
dition number is written cond (A, A). 


Turorem. If Q is unitary, i.e. Q°Q = QQ* = I, and d is a simple eigenvalue of 
A, then 


cond (x, QAQ*) = cond (A, A). 
Proor. Let Az = xd, y*A = dy™. Then 
(QAQ")(Qx) = (Qx)d, — (y*Q*) (QAQ") = A(y*Q*). 
Because ) is simple, y*z ~ 0 and 
cond (d, @AQ*) = || y*Q* ||-|| Qz || / 1 (y*Q*)(@z) |, 
lo" Weel / lye, 
cond (), A), 


because the Euclidean norm is unitarily invariant. O 

Corouuary. If a given matrix B is reduced to Hessenberg form H by unitary simi- 
larities (such as Householder transformations) and the QR algorithm is applied to 
H to produce, in the limit, a quasi-triangular matrix T, then 


cond (\, B) = cond (), T). 


ll 


I 


1.3 The Use and Cost of Condition Numbers. A computed eigenvalue ) of a given 
matrix A is an exact eigenvalue of many matrices including some close to A. Let 
A + E designate onc of the closest matrices. Provided (|| E ||z / || A ||z)” is neg- 
ligible, the error in \ is bounded by cond (A) || £ ||z. Error analyses [6] give an 
upper bound @ on (|| £ ||z/ || A ||z) when the Householder/QR method is used. 
It follows that logiy (| 4 | / 8-cond (A)-|| A ||z) gives the number of decimal digits 
in \ which are assuredly correct. 

When no figures in ) can be relied on, then a warning tag should be attached to 
\ for most applications. Conversely, when an adequate number of figures are 
certified as correct in each eigenvalue of A, then the subsequent calculations are 
placed on a sounder footing. 

These estimates of the number of correct figures have proved useful in the com- 
parison of rival eigenvalue programs and in debugging big programs of which the 
eigenvalue calculations were merely a part. 

A natural question at this stage is how much extra does it cost to compute 
cond (\) as well as \? The answer must depend on whether the user also computes 
x and/or y along with \. We focus on real matrices and real arithmetic. 

(1) If a complete Jordan factorization A = XAY* (Y*X = J) is computed 
then each cond (d;) can be found from the definition || 2; || || y:* || / | yx | at 
negligible extra cost in storage and time. No special program is needed and this 
case will not be considered further. Few dependable Jordan factorization routines 
are currently available. 

(2) If a program is used which yields X and A but not Y%, then it is necessary 
to compute the triangular factorization L,U, and store it in an extra array. Then 


cond (;) = || eX" ||-|| Xe; |]. To invert X costs n° basic operations whereas 
X and A may be found in approximately 7n* operations using the double QR trans- 
formation. 


No special program is needed. The time penalty is slight but the extra storage 
requirement is substantial. This case will not be discussed further. 

(3) The eigenvalues \ of A may be found (EISPACK path, ELMHES, HQR) 
in under 44n’ operations with no supplementary Xn storage arrays provided A 
can be overwritten. This is the most interesting case. No extra arrays are needed 
for the computation of cond (\;), 7 = 1,..., », but the multiplication count 
rises to approximately 7n*. See Section 1.4 for more details. The O(n”) terms bring 
down the ratio of running times; the increase is approximately 50 percent (-+15 
percent). 
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Our method is easily described. The given matrix A is reduced to Hessenberg 
form H by orthogonal similarity transformations. Then H is transformed to quasi- 
triangular Schur form 7’ by the double QR algorithm working on the whole of 
H and not just the remaining principal submatrices. None of the orthogonal trans- 
forming matrices is retained. Finally the column and row eigenvectors of TJ’ are 
found, for each \, by back substitution and then discarded immediately after 
cond (d) has been calculated. 

By Theorem 1, cond (A, 7) = cond (A, A). 

For simplicity all condition numbers exceeding 10° are recorded as 10°. 

The program uses only real arithmetic even if A has complex eigenvalues. 

1.4 Operation Counts. In [5] Parlett and Wang point out that straightforward 
counts of multiplications and additions are unreliable indicators of running times. 
Nevertheless they are good to within a factor of 2 and they do give insight into 
the way the algorithm spends its time. An op is defined as a scalar multiplication 
or division followed by an addition. 

ORTHES. The (n — 7)th step transforms the last 7 rows and columns while 
reducing column (n — j) to upper Hessenberg form. 


Row operations: A — A’ = A — wy(uw"A), y = 2/uTw, wT = (0,...,0,2,..., 2) 
Computation Y wra vt = y(wtA) A — wt Total 
“Cost J 7 J ‘ls 27(j + 1) 
Column operations: A’ > A” = A’ — yA’wut 
Computation ¥ A’w u= yA'w A’ — uvt Total 
Cost 0 nj n ni (B+) 


n-l 
Grand total: >> n(2j + 1) + 2347 +1) = §n(n? — 1) 

j=l 
The program ELMHES is approximately twice as fast as ORTHES but will not 
preserve condition numbers. 

CONDIT. It suffices to assume that all eigenvalues are real. To find the column 
and row eigenvectors for the jth eigenvalue requires backsolving triangular systems 
of (7 — 1) and (n — 7 — 1) equations, respectively. 

Computation x y* Cond 
Cost a t Si n 
Grand total: 4n3 + 4n? + gn 


HQR. A typical double QR transformation acts on a7Xj submatrix of a Hessen- 
berg matrix. To restore column k to Hessenberg form requires the following opera- 
tions for k < 7 — 2. For k = 7 — 1 the cost is 37 + 6 ops. 


Computation Key quantities Row operations Column operations 
oT. 7 min (k+3,7) 
Cost 9 5 5 
i=k i=1 
Total: Dii-t [9+ 5(j—&+1) +5(& +3)] +37 +6 = 57? + 29) — 54 
Assume four initial full transformations with 7 = n and then two iterations 


per eigenvalue. 
Grand total: ne + 47n? + “ n — 182 


QR2NO0Z. The same transformations as in HQR must act on the whole matrix. 
This changes the range of the row operation and not the column because the j Xj 
submatrix being transformed is the leading principal submatrix. 

Computation Key quantities Row operations Column operations 


min(k+3,7) 


Cost 9 >.5 > 5 
l=k 


i=1 
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Total: fai [9 + 5(n —& +1) + 5 + 3)] + 38n + 21 = (5n + 29) — 2) + Bn + 21) 
With the samc assumptions as above, 
Grand total: 5n? + 40n? + 23n — 300 
A summary of operation counts is; 
ELMHES + HQR: 4én? + 47n?2 + 3n — 182; 
ORTHES + HQR: Bn? -+ 47n? + 2n — 182; 
ORTHES + QR2N0Z + CONDIT: 7n? + 40$n? + 214n — 300. 
The actual timings were more favorable to our program than these operation 
counts suggest. The assumption of two itcrations per eigenvalue is unrealistic. 
In practice there are more iterations with larger values of 7 and fewer with small 


values. With 20 < n < 60 our program ran, on the average, 50 percent longer 
than did ELMHES + HQR;; the worst case ran 65 percent longer. 


2. Applicability 
The program accepts real square matrices which can be stored in the high speed 
memory of the computer. 

The condition numbers of all cigenvalues of all normal matrices (and this in- 
cludes symmetric matrices) are unity and conscquently the program is intended 
for use with non-normal matrices. 

Before our programs QR2NO0Z and CONDIT are used, A should be reduced to 
Hessenberg form H by orthogonal congruences. We recommend the proccdure 
ORTHES described in [7] and its. Fortran counterpart ORTHES described in 
[2, p. 297]. 

Our program QR2NO0Z is an adaptation of HQR2 [2, p. 248] and is designed to 
avoid the formation of the product of all the similarity transformations uscd in 
the double QR algorithm and the calculation of the cigenvectors of the final matrix 
of the QR sequence. 


3. Organizational Details 


3.1 Standardization. (i) In the course of the QR algorithm applied to H it is 
possible for two real eigenvalues to be found at the same time as the roots of a 
2X2 diagonal block 

( ') 
y $5)° 


It is convenient in such cases to do a supplementary plane rotation which will 
reduce this diagonal block to upper triangular form and change the correspond- 
ing rows and columns of A accordingly. 

If this transformation is done at the time the cigenvalucs \; and 2 are recorded 
then some of the quantitics which determine the correct angle of rotation will be 
available. 

This device is employed in HQR2 and has been carried over to QR2NOZ. The 
details are given below. 

The parameters c = cos 6, s = sin @ are determincd so that 


c —8\fa Bp ¢ 8s 

8 c}/ \y 6 —s ¢ 
is upper triangular. Thus yc — des — Bs’ = 0, d = 6 — a. Let t = (d/2)” + By; 
then cot 6 = (d/2 + sign (d) ~/t)/2y, s = sign (cot 0)(1 + cot? 6)”, ¢ = s-cot @. 
(ii) It is also convenient to perform a supplementary plane rotation after a 


pair of complex conjugate eigenvalues, \ -+ zu, has been recorded in the course of 
the QR algorithm. In this case the transformation of the diagonal block is 


(SoC 
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where £9 = —uy’. This device is not used in HQR2. 
Note that it is not in general possible to transform 


toll a 


using orthogonal similarity transformations. 

The purpose of the transformation is to yicld a simple solution to certain systems 
of linear equations which must be solved. The supplementary plane rotation is 
done at the stage when the eigenvalues are being recorded in QR2NOZ. In this 
case t = p’ + By < 0, p = (a — &)/2. We want to choose c = cos @ and s = sin 0 
so that 


ac + (B+ y)cs + bs" = 66 — (8B + y)cs + as’. 
Hence 
tan 20 = 28¢/(¢ — s*) = —2p/o = (2|p|/|o|) sign (—po), o =B +4. 
Let r = V/(o" + 4p’). Then 
cos6=q= V(3(1 + cos 26)) = V((1+|o]/7)/2), 
sin 6 = sin 26/2 cos 0 = | p| sign (—pa)/7q. 
3.2 The Computation of the Eigenvectors of a Standardized Real, Block Upper 
Triangular Matrix. For each real eigenvalue \ the eigenvectors u, w”™ satisfy 
Tu = ur, wT = dw". 


For each complex conjugate pair of eigenvalues, \ = zu, the eigenvectors uw - ie 
wi" = iw," satisfy T(u , Ue) = (ur, U2)B, (wi, we)*T = B(wr1, we)*, where 


A A B 
a-() at 


In effecting the back substitution process in real arithmetic there are four differ- 
ent cases which can occur, depending on whether the matrices D and E shown 
below are 1X1 or 2X2: 


a or 
a ae oe D= (° ) 
[) a ae y a 
— é. ate 
O E .- Nor 
E= ( N ‘) 
\9 
where 66 = —y’. The positions of D and Z should be exchanged when considering 


the row eigenvectors. 

Type 1. patr-pair (EK ts 2X2, D is 2X2). Imagine that the elements of uw, ue 
in the same row as D are about to be computed. All elements below these have 
already been found, the elements below E being zcro. 

Let 71, 72 be the rows of T in which D lies. Then the unknowns are 


V= hee io) 
u(j2)  ue(j2)]° 
The equation to be solved in the column case is —DV -+ V2 = R, where 
1) 1re(71) _ m = 71,72 
k= mi(J 2 : ) : = bin Kuby ’ ? 0 
ae r2(j2)] ? am) tes! wk), y = 1,2. (10) 


In the row case let 


Ve Gas a 
wi(j2)  we( 92) 7’ 


ee ee ae 
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then the equations to be solved are 

—V°D + BVT = R*, (11) 
where R is as above except that k runs from 7 to 71 — 1. Transposing yields 

—D'V + VET = R. 


Comparing this with the column case we see that it is only necessary to transpose 
D and EF (i.e. to exchange 8, y and u, —) in order to use the same code for both 
cases. 

The way in which these four linear equations in four unknowns are solved is 
described in Section 3.3. 

Type 2. pair-single (E is 2X2, D ts 1X1). The relevant equations are 


—a(u(j), ue(j)) + (m(J), uJ) )B = (ri(3), mC) 


and 
—ar(ws(j), we(J)) + (wi(j), wa(J)) B® = (ri(9), 72(9))- 


Let d = \ — a,den = d’ + w’, val = — a oie The solution for both cases 


is 
v1 = (-d + 7-val)/den, 
vg = (—ry-val + re-d)/den. 


(12) 


Type 3. single-pair (EF is 1X1, Dis 2X2). The relevant equations are 


1) u(j1) ni(J1) 
_p(“Y ) ( cheers ip ena Mi 
(mac) * (G92) r(72) 
and the same equation for w, with D* in place of D. Set d = \ — a, den = d’ — By. 
The solution is 


m% = (ri(j1)-d + ri(72)-B)/den, 
ve = (ri(j1)-¥ + 1(72)-d)/den, 


_ J8 (for column) . _ Jy (for column) : = 
where B = ‘ (prog and ¥ = B eomeew . In practice B 


T( JJ, J), ¥ = T(J, JJ) and the indices J and JJ are given the values of J1 
and J2 in the appropriate order. 

Type 4. single-single (EH is 1X1, D is 1X1). 4 = m(j)/den, den = X — a. 

Type 5. formula breakdown. If in any of the previous cases D = EK then the 
formulas for solution break down. There are two cases to consider. 

(i) Linear Independence. Any element v; for which the formula yields 0/0 
can be set to any value, the most convenient is 0. This represents the existence of 
a whole space of eigenvectors associated with H. 

(ii) Defective Case. Any element v; for which the formula yields a value ex- 
ceeding 1/TOL will cause the condition number to exceed 1/TOL. If this case is 
detected computation is interrupted, the condition number is set to 1/TOL, and 
the program proceeds to the next eigenvalue. j 

We propose that TOL = 107° will be suitable for most applications and most 
computers. 

These tests make the code simple and machine independent. However, it is : 
possible to devise matrices for which the given value 1/TOL for the condition is 
very misleading. We know of no failsafe procedure which does not involve deciding 
the rank of 7 — é for all & in a neighborhood of d. This is a costly, difficult, and 
often unrewarding task. 

3.3 Closed Form Solution for Equations of Type 1. The equations to be solved 
are of the form —DV +- VE = R, where 


p=(¢ a # = ( rN 4) B= (™ ial 
r al? —p d/’ To. F220, 


(13) 
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The standardization of the block triangular matrix 7' forces the diagonal elements 
of D to be equal. This yields simple formulas for the elements of V. 
Rewrite the equation as 


B —yI 
(On Dig Vai V22) (_ 61s ie ‘) = (ru Ty Tor T22) = ae 
where 
if NPE LB 
RE ( ao ae J) 
Observe that 


B. agh7Re ai | 
ee BG a Bi 


where tr = (A — a)’ + yw’ — By, with By < 0, 


0 0 0 ¥ 

= 0 0 -y O 
= 0B Oo OF}? 
—6 0 0 0 


and J, is the kxk identity matrix. Further, (rl, + QuJ4)(rIy — QuJs) = 
[r” — 4p’(—By) I, . Hence 


(011 O12 Ver Va) (7 + 4yBy) = 77 6 ay (rl, — QJ) 


Bg ~—Bh e —f 
Bh Bg f e€ 


where d = \} — a, e€ = dr, f = u(r + 267), 9 = + — 2, andh = 2dy. Note 
that 


(a? + w — By)’ + 4WBy 
ss g +e 
(= 0 ifandonlyif a=), yw = —By). 


r+ 4y’By 


These same formulas will be valid for the row eigenvectors provided we exchange 
(8, 7) and (KH, —p). 

The alternative to using this closed form solution is to code a special version of 
Gaussian elimination with pivoting. It is the pivoting which would lengthen the 
code considerably. 

3.4 The Condition Number of Conjugate Pairs of Eigenvalues. Let \ + ip be a 
complex pair of eigenvalues of the real Schur matrix 7 obtained by the QR al- 
gorithm. In the course of the algorithm the following real equations are solved for 
real n-vectors U1, U2, Wi, We: 


T (ur, us) = (tts, U2) (2 “, (a1, w2) "= & 4 (wi, we)". (5) 
Thus span (1 , U2) and span (w,", w2") are real invariant subspaces under 7’. How- 
ever, {U1 , U2} and {w,", w:"} are very special bases of these spaces. 
Lemma. With the notation given above, uy ~& iu, and wy = tw,” are the column 
and row eigenvectors belonging to \ + tm. 
Proor. From (5), 


* * 
AW, + Uwe, 


Tu, = Up + Ud, wy, Ps pw + dAw,". 


Tuy = Ur — Up, wy T 


Hence 


T(u + tz) = u(r + im) + tue( tp + d), 
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then the equations to be solved are 

—V'™D + RV? = R’, (11) 
where F is as above except that k runs from 7 toj1 — 1. Transposing yields 

—D'V + VET = R. 
Comparing this with the column case we see that it is only necessary to transpose 
D and FB (i.e. to exchange 8, y and p, —) in order to use the same code for both 
cases. 

The way in which these four linear equations in four unknowns are solved is 


described in Section 3.3. 
Type 2. pair-single (EK is 2X2, D is 1X1). The relevant equations are 


—a(u(j), ue(J)) + (m(7), ua(9))B = (ri), r2(3)) 


and 


—a(wr(j), wa(J)) + (wi(5), we(9)) B® = (r1(39), (3). 


Let d = \ — a, den = d’?+ p’, val = { a i a m) The solution for both cases 
—n ; 


is 
v1 = (m1-d + re-val)/den, 
ve = (—n-val + re-d)/den. 


Type 3. single-patr (FH is 1X1, D is 2X2). The relevant equations are 


1) u(j1) m(j1) 
=p (%9 ) ( eye oe Ohare 
(mc * \ a2) (72) 
and the same equation for w, with D* in place of D. Set d = \ — a, den = d’ — By. 
The solution is 


(12) 


v1 = (ni(71)-d + 1(j2)-B)/den, 
de = (ni(J1)-7 + 71(92)-d)/den, 


_ J8 (for column) . _ Jy (for column) e 
meerenB eS y (for row } sae Beg 7 (for row - In practice B = 


T(JJ, J),¥ = T(J, JJ) and the indices J and JJ are given the values of J1 
and J2 in the appropriate order. 

Type 4. single-single (EH is 1X1, D is 1X1). wu = rni(j)/den, den = A — a. 

Type 5. formula breakdown. If in any of the previous cases D = E then the 
formulas for solution break down. There are two cases to consider. 

(i) Linear Independence. Any element v; for which the formula yields 0/0 
can be set to any value, the most convenient is 0. This represents the existence of 
a whole space of eigenvectors associated with E. 

(ii) Defective Case. Any clement v; for which the formula yields a value ex- 
ceeding 1/TOL will cause the condition number to exceed 1/TOL. If this case is 
detected computation is interrupted, the condition number is set to 1/TOL, and 
the program proceeds to the next eigenvalue. 

We propose that TOL = 10~” will be suitable for most applications and most 
computers. 

These tests make the code simple and machine independent. However, it is 
possible to devise matrices for which the given value 1/TOL for the condition is 
very misleading. We know of no failsafe procedure which does not involve deciding 
the rank of 7’ — é for all € in a neighborhood of \. This is a costly, difficult, and 
often unrewarding task. 

3.3 Closed Form Solution for Equations of Type 1. The equations to be solved 
are of the form —DV + VE = R, where 


nC 2) 8-(2 9. e(2 2) 
y al)’ —p d/J’ Yo toa) 


(13) 
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The standardization of the block triangular matrix 7’ forces the diagonal elements 
of D to be equal. This yields simple formulas for the elements of V. 
Rewrite the equation as 


B —yI 
(V1 Vig Vax V22) Ge . ) = (ru M2 72 2) = 7", 
where 
ee Geo LB 
B= ( ee ge SF 
Observe that 


Bo —yIn\(BT yi. 
(3, ay @ ey = 7], -++ Qu, 


where r = (A — a)” +p’ — By, with By < 0, 


and I, is the kXk identity matrix. Further, (rl, + 2yJ4)(7l4 — 2nJ4) = 
[7? — 4y?(—By)]I,. Hence 
Bt \ 
(v41 Vig Var V2) (7° +t Au"By) = yt 3 7 (rl, — 2nd) 
e —-f vg yh 
ce e yh vg 
Bg —Bh e —f 
Bh Bg ff € 


where d = } — a, ec = dr, f = w(t + 267), 9g = 7 — Qu’, andh = 2du. Note 
that 


(a? + uw — By)” + 4y'By 
mf g ob h’ 
(=0 ifandonlyif a =, w = —6y). 


r+ 4 By 


These same formulas will be valid for the row eigenvectors provided we exchange 
(8,7) and (u, —x). 

The alternative to using this closed form solution is to code a special version of 
Gaussian elimination with pivoting. It is the pivoting which would lengthen the 
code considerably. 

3.4 The Condition Number of Conjugate Pairs of Eigenvalues. Let \} + tm be a 
complex pair of eigenvalues of the real Schur matrix 7 obtained by the QR al- 
gorithm. In the course of the algorithm the following real equations are solved for 
real n-vectors U1, Uz, Wi, W2 ! 


Tusa) = (sea) & #), Gor, anytr=(_2 #) (wo, en)* 6) 
—h p —H p 
Thus span (wu, v2) and span (w,", we") are real invariant subspaces under 7’. How- 
ever, {u1, ua} and {wi", w."} are very special bases of these spaces. 
Lemma. With the notation given above, uz: + iu, and wi = iw” are the column 
and row eigenvectors belonging to X + tp. 
Proor. From (5), 


* * 
Wy + wwe, 


I 


Tur = UA — Ux, wT 


* * 
Tu Up + Uodr, we T = —pUy, + AW2 . 


Hence 


T (ur + tue) = ui(A + tu) + tu2(tu + 2X), 
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(wy = iw") T = (A + ip)wy" — (rv + ip) twe”. 


The eigenvectors for \ — tu are obtained in the same way. O 


Consequently, 


cond (A = tm) = | Ur + tz | : | wi" — iw," | 7 [wre tr 


We Us + 1(wy"ue = We"U2)]. 


Use was made in the lemma of the quasi-triangular nature of 7’. A consequence 
of this form is that uw: and w; can be packed into the same real n-vector with two 


overlapping elements as indicated: 


* 
iS oo Bese @ 
- = > ®: 
De == (Opes 5/0) Des Gis Bee ge @) 
Increment [ 
Set NJ=1, 
ow eigenvecto 
Initialize J, index of ne 
current element (s) 
——>— 


J loop 


Set critical 


indices 


-play+vee! = Rp! (Ng = 1) 


No eigenvalue Yes 
complex? 


solve EQ 
go to 180 


aa 


solve EQ 
go to 180 


Find KS, KF: Yes 
= ? 4 
DO loop scope eu ty 
4 number 
| ompute 
norm 


compute 


condition 
numbers 


No jeigenvalue\ Yes 
\ complex? | 


Fig. 1. Flowchart representing way in which column and row eigenvectors are computed 
allowing for haphazard ordering of 1X1 and 2X2 blocks on diagonal of real 


Schur form 
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The equations to be satisfied by p; , g; are of the form 


C90 D-CL 0" 
y J\Q @& a —p KN : 
ee 9-0 Ds 
Do Ge) \y X —p AJ \Pe ; 


where p’ = —By. These equations reduce to 
Bq2 = Pip, PiB = uq2, 
Bq. = —ep2, Bp, = —vh. 
The simplest solution (which we adopt) takes 1 = f1 = 1, MW =P = = fr = 9, 
Q2 = p/B, G2 = 1/q2. With this choice, 
(w1 — twe)*(ur + iuz) = (fpr + Bepe) + (Gu + Gq) = 2 and 
cond (A iu) = [(|[ ua |]? + |] me (7) CI] en Uf? + | ee I?) P72. (14) 
4. The Structure of CONDIT 


As indicated in Section 3.2 the same section of code (the J loop) computes the 
column and the row eigenvector of the /th eigenvalue. It is the standardization 
of the Schur form which permits this econofy. J, which always points to the 
block D, decreases for the column eigenvector (NJ =: 0) and increases for the 
row eigenvector (NJ = 1), as indicated: 


NJ =0 NJ =1 


where 06 = —p. 
Is the 0 diagonal element in I° a keypunch error or did it really belong in the user’s problem? 


Lo = é %)5 1° = diag(0, 1,1,..., 1); 


Io 0 
b 
D TT, 0 = 
x -(" F, —F, }10%; F(? :) = ama | 
0 -F; Fy z 
d 
D = diag(.5221, 3563, .5552 X 107%, .1328); 
5221 0 0 — 8951 
c, = {9 —.3563 6109 0 
+" \o 0 — .5552 X 10-3 0 ; 
0 0 0 — .1328 
—.0976 0 0 0 
0 —.0666 0 0 
T,=\0 02659 —.4218 xX 10-* 0 
—.03896 0 0 —.1009 X 107 
2.859 0 0 1.079 
rea [° 2.828  —1.026 0 
F 0 — .2389 4294 0 i 
2513 0 0 4607 
_ (2.761 5891 \. _ of 1.627 .5373\_ _ {1.849 .3731\. 
note r( .2128 esa Pa F( .1096 ay Hae F( 1178 cae 


|| L® ||, 5 X 108. 


Fig. 2. 24X24 matrix for case study 
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Table I. Eigenvalues and Condition Numbers of L®, L, M 


Cond 
(L°) (bal- 

1 (L®) ‘Cond(L) anced) 1 (L) Cond (L) ;(M) Cond(M) 

+ .21534594 104 1 +t .215384594 104 + .21534594 104 
105 105 105 

+ .18667890 104 108 + . 18654343 104 + .18692513 104 
105 <105 105 

+ .11076317 6x 10? 4x 103 +.1098668V 6 xX 10° + .11142610 6 X 10 
«1057 X105 X105¢ 

+ .82614552 6x 108 5x 108 + .8646568V 104 = .863389960 104 
104 x104 <104* 

=k .83281998 6 X 108 1 + .83281998 6 xX 103 + .83281998 6 xX 103 
104 104 x104 

+ .41438248 7 xX 108 104 + .7026706V 104 + .71883679 104 
104 «104 x<104* 

+ .64209960 7 X 10° 3 + .64209960 6 x 103 + .64209960 7 X 108 
x 104 104 104 

+ .383632953 5x10? 9 x 103 +t .388448590 3 x 103 + .88458962 3 X 108 
«104 104 x<104* 

+ .35102700 2 X 10° 4 + .35102700 2x103° +.35102700 2 X 10? 
104 104 104 

+ .80530592 3 X 108 3 + .30530592 3 xX 103 + .80530592 3 X 10° 
x104 x 104 x 104 

+.0f 1015 102° + .29241979 3 X 103 + .29134631 3 X 10 

x104 104 

+t .23559292 102 1 + .23559291 102 + .23559292 102 

108 103 10? 


* The imaginary pair of eigenvalues had real parts less than 10° (a relative error of 10711). 
V denotes a digit that changed when the matrix was balanced. 
+t The unbalanced matrix L® had a negative eigenvalue —210-8 instead of —0. 


At each major step in the J loop the equations EQ, given in the chart, are solved 
as D varies. Four cases are shown in the flowchart which is Figure 1. 


5. Results 


The matrix L’ described in Figure 2 came (in punched card form) from a large 
industrial company. It was causing their eigenvalue program to fail. 

An inspection of the form of L’ suggests that the strange diagonal element in 
I and the discordant sign of the (1,1) element of T, were keypunch errors. Let 
us consider the matrices resulting from the removal of these anomalies: 


0 x 0 Y 
w=(r 9), = (ro): 
D Tr 0 


Y=10(T. T, —F.], 
0 —F; F, 


where Ti is obtained from T; by reversing the sign of its (1, 1) element. 
Notice that the eigenvalues of L are the square roots of those of X: 


ser Yass =a(5 «+ Xv = \’v, u = Dv. 
I 0/\v v 


The eigenvalues of L’, L, and M are given in Table I and we offer the following 
comments. Every eigenvalue of L’ is moderately ill conditioned and the zero pair 
appear to belong to a quadratic elementary divisor (only one eigenvector). Per- 
haps some of this is due to the unbalanced nature of L’. The thirteenth row of L’ 
is null and this must be permuted out of the way before the rest of the matrix can 
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be balanced. The result is that none of the computed. eigenvalues changed, but 
half of them became almost perfectly conditioned. 

In fact we can say that the ill condition of all six pairs is due to the zero element 
in position (18,1). When this is replaced by one, we obtain the matrix L which 
has six pairs of eigenvalues almost identical to the well conditioned pairs of the 
balanced L’. Four of the other six pairs are changed completely, the remaining 
two (+.186 X 10° and +.11 x 10°) are substantially altered. Interestingly the 
balanced versions of L and M are almost normal and we have not bothered to 
record the condition numbers. The six pairs of eigenvalues which were unchanged 
by the move from L’ to L were also invariant in the change from L to M. The other 
six pairs had relative errors less than 2.5 percent. 

We can tell in advance what the balanced form of L and M will be: 

0 10°X 7 0 10“Y 
L = e 0 Yi ee ine 0 ). 
The change from L’ to L is tiny relative to || L’ || (+ 107° || L’ ||) but the change 
from L’ to £ is approximately || f ||. 

We conclude that the suspicious element in L’ was probably a keypunch error. 
Concerning the (1, 1) element of T; we cannot say, both L and M are reasonable 
matrices and indeed the change of sign does not affect the leading two decimals 
in any eigenvalue. 
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ALGORITHM 
SUBROUTINE QR2NOZ(NM, N, LOW, IGH, H, WR, WI, IERR) QR2 10 
PURPOSE QR2 26 
THE FORTRAN SUBROUTINE QR2NOZ COMPUTES THE EIGENVALUES OF A REAL QR2 36 
UPPER HESSENBERG MATRIX USING THE QR METHOD AND REDUCES THE QR2 46 
MATRIX TO A STANDARDIZED QUASI-TRIANGULAR FORM. COMPUTATIONS QR2 5¢@ 
ARE DONE IN REAL ARITHMETIC. QR2 6 
THE SUBROUTINE STATEMENT IS QR2 7 
SUBROUTINE QR2NOZ(NM,N,LOW, IGH,H,WR,WI,IERR). QR2 8 
NM IS AN INTEGER INPUT VARIABLE SET EQUAL TO THE ROW DIMENSION QR2 9@ 
OF THE ARRAY H AS SPECIFIED IN THE CALLING PROGRAM. QR2 166 
N IS AN INTEGER INPUT VARIABLE SET EQUAL TO THE ORDER OF THE QR2 11@ 
MATRIX H. N .LE. NM QR2 120 


LOW,IGH ARE INTEGER INPUT VARIABLES INDICATING THE BOUNDARY INDICES QR2 130 
FOR THE BALANCED MATRIX. IF THE MATRIX IS NOT BALANCED SET QR2 14@ 


LOW TO 1 AND IGH TO N. QR2 15¢ 
H IS A REAL TWO-DIMENSIONAL ARRAY WI1H ROW DIMENSION NM AND QR2 160 
COLUMN DIMENSION AT LEAST N. ON INPUT IT CONTAINS THE QR2 17¢ 
UPPER HESSENBERG MATRIX OF ORDER N. ON OUTPUT IT CONTAINS QR2 18@ 
THE STANDARDIZED QUASI-TRIANGULAR MATRIX. QR2 196 
WR, WI ARE REAL OUTPUT ONE-DIMENSIONAL VARIABLES OF DIMENSION AT QR2 200 
LEAST N CONTAINING THE REAL AND IMAGINARY PARTS, QR2 21¢ 


RESPECTIVELY, OF THE EIGENVALUES OF THE HESSENBERG MATRIX. QR2 226 
THE EIGENVALUES ARE UNORDERED EXCEPT THAT COMPLEX CONJUGATE QR2 23@ 
PAIRS OF EIGENVALUES APPEAR CONSECUTIVELY WITH THE QR2 246 
EIGENVALUE HAVING THE POSITIVE IMAGINARY PART FIRST. QR2 250 
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C IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR 
C COMPLETION CODE. IF MORE THAN 3@ ITERATIONS ARE REQUIRED 
C TO DETERMINE AN EIGENVALUE, THIS SUBROUTINE TERMINATES WITH 
C LERR SET EQUAL TO THE INDEX OF THE EIGENVALUE FOR WHICH 
( FAILURE OCCURS. THE EIGENVALUES IN THE WR AND WI ARRAYS 
C SHOULD BE CORRECT FOR INDICES IERR+1,IERR+2,...,N. IF ALL 
C THE EIGENVALUES ARE DETERMINED WITHIN 3@ ITERATIONS, IERR 
c IS SET TO ZERO. 
DIMENSION H(NM,N), WR(N), WI(N) 
REAL MACHEP 
INTEGER EN, ENM2 
LOGICAL NOTLAS 
C MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING THE RELATIVE 
C PRECISION OF FLOATING POINT ARITHMETIC. THE VALUE BELOW IS 
C EQUAL TO 2.**(-46), WHICH IS APPROPRIATE FOR CDC 60@@¢-SERIES 
C MACHINES. 
DATA MACHEP /164249690060006000000B/ 
IERR = @ 
C STORE ROOTS ISOLATED BY BALANC 
DO 1@ I=1,N 
IF (I.GE.LOW .AND. I.LE.IGH) GO TO 1¢ 
WR(L) = H(I,1) 
WI(I) = @. 
19 CONTINUE 
EN = IGH 
T = 0.6 
C SEARCH FOR NEXT EIGENVALUES 
20 IF (EN.LT.LOW) RETURN 
ITS = @ 
NA = EN - 1 


ENM2 = NA - lL 
LOOK FOR SINGLE SMALL SUB-DIAGONAL ELEMENT 
FOR L=EN STEP —1 UNTIL LOW DO 
30 IF (EN.EQ.LOW) GO TO 50 
DO 4@ LL=LOW,NA 
L = EN + LOW - LL 
IF (ABS (H(L,L-1)) .LE.MACHEP* (ABS (H(L-1,L-1) )+ABS (H(L,L)))) 
* GO TO 60 
4@ CONTINUE 
5@ L = LOW 
C FORM SHIFT 
6% X = H(EN,EN) 
IF (L.EQ.EN) GO TO 20¢ 
Y = H(NA,NA) 
W = H(EN,NA)*H(NA,EN) 
IF (L.EQ.NA) GO TO 21@ 
IF (ITS.EQ.30) GO TO 27¢ 
IF (ITS.NE.1@ .AND. ITS.NE.2@) GO TO 8¢@ 
C FORM EXCEPTIONAL SHIFT 
T=T+X 
DO 7@ I=LOW,EN 
H(I,1) = H(I,I) - xX 
7@ CONTINUE 
S = ABS(H(EN,NA)) + ABS(H(NA,ENM2) ) 


an 


X = @.75*S 
Y=X 
W = -0.4275*S*S 


8@ ITS = ITS + l 
C LOOK FOR TWO CONSECUTIVE SMALL SUB~DIAGONAL 
C ELEMENTS. FOR M=EN-2 STEP -1 UNTIL L DO 
DO 9¢ MM=L,ENM2 
M = ENM2 + L - MM 


= Y ~ ZZ 
= (R*S-W)/H(M+1,M) + H(M,M+1) 
H(M+1,M+1) - ZZ -R-S 
H (M+2 ,M+1) 
ABS(P) + ABS(Q) + ABS(R) 
P/S 
Q/s 
R/S 
IF (M.EQ.L) GO TO 1¢¢ 
IF (ABS(H(M,M-1) )* (ABS (Q)+ABS (R) ) .LE.MACHEP*ABS (P)* 
* (ABS (H(M~1 ,M-1) )+ABS (ZZ) +ABS (H (M+1,M+1)))) GO TO 14¢ 
9@ CONTINUE 
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196 MP2 = M+ 2 QR2 1626 
DO 110 I=MP2,EN QR2 1630 
H(I,I-2) = 9.¢ QR2 1640 

IF (1.EQ.MP2) GO TO 11¢ QR2 1650 
H(1,1I-3) = @.@ QR2 1966¢ 

11@ CONTINUE QR2 1676 
C DOUBLE QR STEP INVOLVING ROWS L TO EN QR2 1680 
C AND COLUMNS M TO EN. QR2 169¢ 
DO 19% K=M,NA QR2 1160 
NOTLAS = K.NE.NA QR2 1110 

IF (K.EQ.M) GO TO 12@ QR2 1120 

P = H(K,K-1) QR2 113¢ 

Q = H(K+1,K-1) QR2 114@ 

R = 0.@ QR2 115¢ 

IF (NOTLAS) R = H(K+2,K-1) QR2 1160 

X = ABS(P) + ABS(Q) + ABS(R) QR2 1170 

IF (X.EQ.6.@) GO TO 19¢ QR2 118 

P = P/X QR2 1196 

Q = Q/x QR2 1260 

R = R/X QR2 1210 

120 S = SIGN(SQRT (P*P+Q*Q+R*R) ,P) QR2 122¢ 
IF (K.EQ.M) GO TO 13@ QR2 1230 
H(K,K-1) = -S*X QR2 1246 

GO TO 14¢@ QR2 1250 

130 IF (L.NE.M) H(K,K-1) = -H(K,K-1) QR2 1266 
144 P=P+S5 QR2 127¢ 
X = P/S QR2 128¢ 

Y = Q/S QR2 1296 

ZZ = R/S QR2 1300 

Q = Q/P QR2 1310 

R = R/P QR2 132¢ 

C ROW MODIFICATION QR2 133¢ 
DO 16@ J=K,N QR2 134¢ 

P = H(K,J) + Q*H(K+1,J) QR2 135¢@ 

IF (.NOT.NOTLAS) GO TO 15¢ QR2 136 

P = P + R*H(K+2,J) QR2 1376 
H(K+2,J) = H(K+2,J) - P*ZZ QR2 1380 

15¢@ H(K+1,3) = H(K+1,J) - P*Y QR2 1396 
H(K,J) = H(K,J) - P*x QR2 14¢¢ 

169 CONTINUE QR2 141¢ 
J = MIN@(EN,K+3) QR2 1426 

C COLUMN MODIFICATION QR2 1436 
DO 189 I=1,J QR2 1446 

P = X*H(I,K) + Y*H(1,K+1) QR2 145¢ 

IF (.NOT.NOTLAS) GO TO 17¢ QR2 1466 

P = P + ZZ*H(1,K+2) QR2 147¢ 
H(1,K+2) = H(1,K+2) - P*R QR2 1480 

17¢ H(I,K+1) = H(1I,K+1) -— P*Q QR2 1496 
H(I,K) = H(1I,K) - P QR2 1500 

186 CONTINUE QR2 151¢ 
19% CONTINUE QR2 1520 
GO TO 30 QR2 153¢ 

C ONE ROOT FOUND QR2 1546 
20@ H(EN,EN) = X + T QR2 155 
WR(EN) = H(EN,EN) QR2 156¢ 
WI(EN) = @.@ QR2 157¢ 

EN = NA QR2 1580 

GO TO 2@ QR2 159¢ 

C TWO ROOTS FOUND QR2 1600 
210 P = (Y-X)/2.0 QR2 1610 
Q = P*P + W QR2 162¢ 

ZZ = SQRT(ABS(Q)) QR2 163 
H(EN,EN) = X+T QR2 1640 

X = H(EN,EN) QR2 1659 
H(NA,NA) = Y+T QR2 1660 

IF (Q.LT.@.6) GO TO 22¢ QR2 1676 

ZZ = P + SIGN(ZZ,P) QR2 1680 

C REAL PAIR QR2 169¢ 
WR(NA) = X + ZZ QR2 17060 
WR(EN) = WR(NA) QR2 171 

IF (ZZ.NE.@.@) WR(EN) = X - W/ZZ QR2 172¢ 
WL(NA) = 6.0 QR2 173¢ 
WI(EN) = ¢.¢@ QR2 1740 

X = H(EN,NA) QR2 175¢ 

R = SQRT (X*X+Z2Z*ZZ) QR2 1760 


P = X/R QR2 177¢ 
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Qe= 


ZZ/R 


GO TO 23¢ 
C COMPLEX PAIR 


22@ WR(NA) 
WR (EN) 
WI (NA) 


vou ow 
Ne Pd 


WI(EN) = -ZZ 

MAKE DIAGONAL ELEMENTS EQUAL 
IF (P.EQ.@.6) GO TO 260 
BPC = H(EN,NA) + H(NA,EN) 


TX = 


Q= 


SQRT (BPC*BPC+4 .G*P*P) 


SQRT(.5*(1.G+ABS (BPC) /TX) ) 


P = SIGN(P/(Q*TX) ,-BPC*P) 
ROW MODIFICATION 
23@ DO 246 J=NA,N 
ZZ = H(NA,J) 


H(NA,J) 
H(EN,J) 


Q*ZZ + P*H(EN, J) 
Q*H(EN,J) - P*ZZ 


249 CONTINUE 
COLUMN MODIFICATION 
DO 25@ I=1,N 


1H 
H(I,NA) 
H(I,EN) 


= H(I,NA) 
Q*ZZ + P*H(L,EN) 
Q*H(L,EN) - P*ZZ 


25@ CONTINUE 


260 EN = 


ENM2 


GO TO 2@ 
270 IERR = EN 
RETURN 


END 


SUBROUTINE CONDIT(NM, N, A, V1, V2, WI, COND) 


CONDIT COMPUTES THE CONDITION NUMBERS OF THE EIGENVALUES OF A 


STANDARDIZED QUASI-TRIANGULAR MATRIX. 
THE SUBROUTINE STATEMENT IS 


ON INPUT 
NM MUST BE SET TO THE ROW DIMENSION OF THE TWO DIMENSIONAL 
ARRAY AS DECLARED IN THE CALLING PROGRAM. 
N IS THE ORDER OF THE MATRIX. N.LE.NM 
A CONTAINS THE STANDARDIZED QUASI-TRIANGULAR MATRIX PRODUCED 
BY QR2NOZ. 
WI CONTAINS THE IMAGINARY PARTS OF THE EIGENVALUES. THE 


SUBROUTINE CONDIT(NM,N,A,V1,V2,WI,COND) . 


EIGENVALUES ARE UNORDERED EXCEPT THAT COMPLEX CONJUGATE 


PAIRS APPEAR CONSECUTIVELY. 


V1,V2 ARE FOR TEMPORARY STORAGE. 


ON OUTPUT 
A IS UNALTERED. 
COND CONTAINS THE CONDITION NUMBERS CORRESPONDING TO THE 
EIGENVALUES IN (V2,WI). COND = 1./TOL IF THE USUAL 
FORMULA WOULD CAUSE OVERFLOW OR YIELD A VALUE EXCEEDING 
1/TOL. TOL NEED NOT DEPEND ON THE COMPUTER. 
v2 CONTAINS THE REAL PARTS OF THE EIGENVALUES. 


TYPICAL USAGE 


DIMENSION A(5@,50) ,WR(5@) ,W1I (50) ,COND (50) , ORT (5@) 
RERKEKKKKKRKEKKAKRKAKENTER MATRIX A AND DIMENSIONS N  NMAAXAKAKAKAKAKAKEKCON 
LOW=1 
IGH=N 
CALL ORTHES(NM,N,LOW, IGH,A, ORT) 
CALL QR2NOZ(NM,N,LOW, IGH,A,WR,WI, IERR) 
CALL CONDIT(NM,N,A,ORT,WR,WI,COND) 
RRERKEKKERRKREERERREREKREK ER RERRERRERRERERERERERERERRRERERRREK EER REREERERECON 
NOTE THE USE OF ORT AND WR IN CONDIT 
DIMENSION A(NM,NM), V1(NM), V2(NM), WI(NM), COND(NM) 
DIMENSION R1(2), R2(2) 
DATA TOL /1.E-3@/ 
--------+----- ++. - +--+ +--+ 5 - +--+ - + + + + 5-5-5 = = + === CON 


I = 


1 


19 IF (I.GT.N) GO TO 196 
VALR = A(I,TI) 


VALI 


= WI(I) 


VALI2 = VALI*VALI 
C NJ GIVES EIGENVECTOR TYPE, @ FOR COLUMN, 1 FOR ROW 


NJ 


i) 


C INITIALIZE NONZERO ELEMENTS OF EIGENVECTOR (V1,V2) 
Vi(I) = 1.4 


QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 
QR2 


CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 


CON 
CON 
CON 
CON 
CON 


CON 
CON 
CON 
CON 


CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 


517-P15- 


0 


COLLECTED ALGORITHMS (cont.) 


Oe 4° Oo 


QO 


V2(L) = ¢.¢ CON 

20 J= 1 - 1+ 2*NJ CON 
IF (VALI.EQ.@.6) GO TO 30 CON 
V2(I+1) = VALI/A(I,I+1) CON 
VI(I+1) = 6.0 CON 

IF (NJ.EQ.1) V2(I+1) = 1.@/V2(I41) CON 
J=1I- 1 + 3*NJ CON 
FIND THE INDICES OF ELEMENTS COMPUTED SO FAR CON 
39 KS = J + 1 + NJ*(I-J-1) CON 
KF = I + 1 + NJ*(J-I-2) CON 

IF (VALI.EQ.@.@ .AND. NJ.EQ.@) KF = KF - 1 CON 
TEST FOR COMPLETION OF EIGENVECTOR CON 
IF ((J+NJ.LT.1) .OR. (J+NJ.GT.N+1)) GO TO 13¢ CON 


RRKKKERERERERERERERERERRRERRRERERERERERERERERERERERERERRERRERRERERERERECON 
*SOLVE -D*V + V*E = R FOR V = (V1,V2). D IS A DIAGONAL BLOCK IN ROWS CON 
* J1,J2, AND E IS THE REAL CANONICAL FORM OF THE ITH EIGENVALUE. CON 
* EITHER D OR E OR BOTH CAN BE 1 BY 1 CON 
REKKKAKKKRRRERERERERRRRRERERRRERRERERRRRRRRERERRRERRRRERRERERERERERRRREKECON 
FIND Jl AND J2 (J1.LE.J2) FOR ALL CASES CON 
JJ=J CON 

IF (WI(J).NE.@.@) JJ = J - 1 + 24*NJ CON 

J@ = NI*(J-JJ) CON 

Jl = JJ + J@ CON 
J2=J- J@ CON 

Dl = VALR - A(J,J) CON 
CALCULATE RIGHT HAND SIDE R CON 
DO 70 L=J1,J2 CON 

LJ =L-J1+1 CON 
R1(LJ) = @.¢@ CON 
R2(LJ) = 9.@ CON 

IF (VALI.NE.@.@¢) GO TO 5@ CON 

DO 40 K=KS,KF CON 

LK = NJ*(K-L) CON 

AA = A(L+LK,K-LK) CON 

RI(LJ) = R1(LJ) + AA*VI(K) CON 

40 CONTINUE CON 
GO TO 70 CON 

50 DO 60 K=KS,KF CON 
LK = NJ*(K-L) CON 

AA = A(L+LK,K-LK) CON 

R1(LJ) = RI(LJ) + AA*VI1(K) CON 

R2(LJ) = R2(LJ) + AA*V2(K) CON 

6% CONTINUE CON 
7@ CONTINUE CON 
IF (JJ.NE.J) GO TO 100 CON 
REKKRRAKERERERERERERERREREREREED ITS 1 BY 1 KREREKKKERKERERERERERERKREERERECON 
IF (VALI.NE.@.@) GO TO 8@ CON 

E IS 1 BY 1 (D IS 1 BY 1) CON 
IF (ABS(D1) .LT.TOL*ABS(R1(1))) GO TO 18 CON 
V1(J) = 0.¢@ CON 
V2(J) = 0.0 CON 

IF (D1.NE.@.@) V1(J) = R1(1)/D1 CON 

GO TO 9¢ CON 

E IS 2 BY 2 (DIS 1 BY1 ) CON 
86 DEN = D1*D1 + VALI2 CON 
VAL = VALI* (-1.0) **NJ CON 
VI(J) = R1(1)*D1 + R2(1)*VAL CON 
V2(J) = R2(1)*D1 - R1(1)*VAL CON 
VMAX = AMAX1(ABS(V1(J)),ABS(V2(J))) CON 

IF (DEN.LT.TOL*VMAX) GO TO 180 CON 
V1(J) = V1(J)/DEN CON 
V2(J) = V2(J)/DEN CON 
NEXT J CON 
996 J = J - 1 + 2*NJ CON 
GO TO 3¢ CON 
REEKEREKEKRKEKERERERRERERAREREKERKDE TS 2 BY 2XRKKKAKEKKKKKRERERERERERKERERCON 
106 IF (VALI.NE.@.@) GO TO 11¢ CON 
E IS 1 BY 1 (D IS 2 BY 2) CON 
DEN = DIXD] + WI(J)**2 CON 
V2(J1) = 0.@ CON 
V2(J2) = 0.¢ CON 
V1(J1) = R1(1)*D1 + R1(2)*A(JJ,J) CON 
V1(J2) = R1(1)*A(J,JJ) + R1(2)*D1 CON 
VMAX = AMAX1(ABS(V1(J1)),ABS(V1(J2))) CON 

LF (DEN.LT.TOL*VMAX) GO TO 18¢@ CON 


V1(J1) = V1(J1) /DEN CON 
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V1(J2) = V1(J2)/DEN 


GO TO 129 
C E IS 2 BY 2 (D IS 2 BY 2). CLOSED FORM SOLUTION 

119 B = A(JJ,J) 
C = A(J,JJ) 
VAL = VALI*(-1.) *#NJ 
BXC = BxC 
H = D1*D1 + VALI2 - BXC 
E = D1*H 
F = VAL*(H+2.@*BXC) 
G = H - 2.@*VALI2 
H = 2.Q*DL*VAL 
VI(J1) = RI(1)*E + R2(1)*F + R1(2)*B*G + R2(2)*B*H 
V2(J1) = -R1(1)*F + R2(1)*E - R1(2)*BAH + R2(2)*B*G 
V1(J2) = R1(1)*C*G + R2(1)*C*H + R1(2)*E + R2(2)4*F 
V2(J2) = -R1(1)*C*H + R2(1)*C*G - R1(2)*F + R2(2)*E 


VMAX = AMAX1(ABS(V1(J1)),ABS(V2(J1)) ,ABS(V1(J2)) ,ABS(V2(J2))) 
DEN = G*G + H*H 

IF (DEN.LT.TOL*VMAX) GO TO 180 

IF (DEN.EQ.@.6) GO TO 12¢ 


V1(J1) = V1(J1)/DEN 
V2(J1) = V2(J1)/DEN 
V1(J2) = V1(J2) /DEN 
V2(J2) = V2(J2)/DEN 
C NEXT J 
126 J=J-2 + 44NJ 
GO TO 3@ 


C COMPUTE EIGENVECTOR NORM 
13@ VMAX = @.@ 
DO 14@ K=KS,KF 
VMAX = VMAX + V1(K)**2 + V2(K)**2 
149 CONTINUE 
IF (NJ.EQ.1) GO TO 15¢ 
C PREPARE TO COMPUTE ROW EIGENVECTOR 
NJ = 1 
CNORM2 = VMAX 
GO TO 29 
C COMPUTE CONDITION NUMBER 
15@ COND(I) = SQRT(CNORM2*VMAX) 
160 IF (VALI.EQ.0.0) GO TO 17@ 
COND(I) = COND(I)/2.@ 
COND (I+1) -= COND(I) 
l=I+1 
C NEXT I 
17@1=I1+1 
GO TO 1¢ 
C DEFECTIVE CASE 
18 COND(I) = 1.6/TOL 
GO TO 16¢ 
C PLACE REAL PART OF EIGENVALUE IN V2 
19% DO 20 I=1,N 
v2(I) = A(I,1I) 
20@ CONTINUE 
RETURN 
END 


CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
CON 
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CON 
CON 
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122¢ 
1230 
1240 
1250 
1260 
1270 
1280 
129¢ 
1300 
131¢ 
132@ 
133¢ 
134¢ 
1350 
1360 
137¢ 
1380 
139¢ 
1460 
1410 
142¢ 
143¢ 
1440 
1450 
1460 
147 
148¢ 
1490 
1500 
151¢ 
152¢ 
1530 
1546 
155@ 
156@ 
157@ 
158¢ 
1590 
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1619 
162¢ 
163@ 
1646 
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166@ 
167@ 
168@ 
1690 
17060 
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ALGORITHM 518 
Incomplete Bessel Function |,: The Von Mises 


Distribution [S14] 


GEOFFREY W. HILL 
Centre de Morphologie Mathématique, Fontainebleau, France 


Key Words and Phrases: incomplete Bessel function, von Mises distribution, direction 
angles, circular statistics, asymptotic normal approximation 

CR Categories: 5.5, 5.12 

Language: Fortran 


DESCRIPTION 


The incomplete modified Bessel function Jo(0, x) is formally equivalent to the 
cumulative distribution applied by von Mises [9] to study deviations of atomic 
weights from integer values, representable as points on the circumference of a 
circle or as circular directions. This distribution of points on a circle is analogous 
to the normal or Gaussian distribution of points on a line and has applications 
to the study of quantal or periodic data, directions of sedimentary bedding, surface 
fault lines, wildlife movements, etc. (cf. Batschelet [3] and Mardia [7]). The left 
tail area of this symmetrical distribution is evaluated by this Fortran FUNCTION 
of the angular deviation © and the concentration parameter x, where 


8 
Ih(0,«) = P(x < O;«) = (2alo(«)I* [ exp (x cos x) dz, —@r<O< gf. 


A compromise between generality and efficiency is achieved by parameterizing 
the algorithm so that versions corresponding to different levels of accuracy are 
provided by selecting parameter sets as displayed in Table I. 

The method of calculation for small « involves backwards recursion through a 
series expansion in terms of modified Bessel functions, while for large «x an auxiliary 
FUNCTION for the normal probability integral or for the error function erf (2) 
is applied to an asymptotic normal approximation to order « “. 

In the case of small « the series expansion given by Gumbel et al. [6] can be ex- 
pressed as 


F(0; «) = 4 + 0/(2r) + {To(«e)} 2, Tn (x) sin (n0) 
+ 0/(2r) + 4r°Vi, 


where Vi = Ri(x) [sin 0 + Re(x) [27 sin 20 + R3(x) [3 sin 30 + ---]]] repre- 
sents a “nested” expression in terms of R,(xk) = In(k)/Ina(k), nm = 1, 2, 3,..., 


bol 


Received 12 December 1975 and 8 June 1976. 

Copyright © 1977, Association for Computing Machinery, Inc. General permission to republish, 
but not for profit, all or part of this material is granted provided that ACM’s copyright notice 
is given and that reference is made to the publication, to its date of issue, and to the fact that 
reprinting privileges wére granted by permission of the Association for Computing Machinery. 
This work was supported by a French Government Scientific Fellowship and a grant of 
computer time on the IRIS 80 of the Ecole des Mines de Paris. 

Author’s present address: Division of Mineral Chemistry, CSIRO, Port Melbourne, Australia. 


ACM Transactions on Mathematical Software, Vol. 3, No. 3, September 1977, Pages 279-284. 


COLLECTED ALGORITHMS (cont.) 


Table I. Parameter Values for Several Accuracy Levels 


Recurrence over 


Accuracy Critical 

in decimal [ar + aan — as/(« + a)] value of Normalizing 
digits eat ‘ pa = nested aaa ee K approximation 

(D) a1 ae a3 aa (CK) (C1) 

6 8 1.0 3.0 1.0 6.5 62.0 

7 9 1.0 3.5 0.7 8.0 60.5 

8 12 0.8 8 1.0 10.5 56.0 

9 15 0.75 16 1.5 15 53.0 

10 18 0.7 24 2.0 21 51.7 

11 22 0.6 48 3.5 32 50.8 

12 28 0.5 100 5.0 50 50.1 


the modified Bessel function ratio denoted as rn_1 by Amos [2]. Recursive evaluation 
of the Bessel function ratio is known to be numerically unstable in the direction of 
increasing n, but backwards recursion generates additional terms of the series ex- 
pansions in powers of «x, so that numerical stability is achieved forn = p — 1,..., 
3, 2, 1, from the formulation: 


sin nO = sin (n + 1)0 cos 8 — cos (n -+ 1)0 sin O 
cos n@ = cos (n + 1)O0 cos 8 + sin (vn -+ 1)O sin © 
Ra(x) = [2n/e + Raye)! (ef. [2, eg. (2))) 

Vn = Ra(x) [sin (n0)/n + Val. 


Starting values can be computed directly for sin (p@) and cos (pO), while R,(«) 
and V, may be assigned zero values, provided p is large enough, since I,(«)/Jo(«) 
< (x/2)”/p! implies that the truncation error of V1 will be less than the correspond- 
ing truncation error of the convergent series expansion of exp («/2). An upper 
bound on the truncation error was calculated for various combinations of values 
of x and p. Curves of p(x; D), interpolated for assigned accuracy levels of D deci- 
mal places, were found to be conservatively bounded by relations of the form 
p = [a1 + dex — a3/(k + as)], where suitable values of coefficients a1, d2,..., are 
shown in Table I. Since larger values of «x entail larger values of p and thus more 
computing time and accumulated roundoff error, an alternative method is desired 
when « is larger than some critical value, which we denote by CK. 

For large values of « the asymptotic normality of the von Mises distribution 
may be exploited in the following three steps. First, the angle © is transformed to 
the nearly normally distributed variate z = b(x) sin (0/2), where b(k) =(2/r)'” 
exp (x)/Zo(k) is conveniently computed from a continued fraction approximation: 


b'(«) = (C — 6 — 54/(C — 26 — 347/(C — C1)))/6, C = 24x. 


Values for C1, fitted for the minimum value of « = CK are included in Table I. 
The second step uses an approximation to order « ’ for the asymptotic normalizing 
series in terms of z [4]: 


—2 
x = 2-2 { (0-28 16)/3 — (“+744 181) / (co - Cy— 2+ ay} 


in which the same value of C1 is used in the divisor to reduce the remaining error of 
order «x °. The third step calls an auxiliary function, GAUSS (x), to evaluate the 
normal integral 


P(x) = (Qn) [ exp (—t'/2) di 


which, by virtue of the normalizing transforms, provides the required value of the 
von Mises integral, F(0; x) = ®(x). Alternatively the normal integral may be 
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evaluated in terms of the error function, erf (x), by virtue of the relationship, 
@(xz) = 4[1 + erf (2//2)], where erf (—z) = —erf (2). 

The error of the asymptotic approximation decreases rapidly with increasing 
x and can be calculated by comparison with sutticiently accurate results from the 
backwards recursion method. In this way critical values of CK in Table I were 
obtained such that for x > CK the asymptotic approximation is accurate to at 
least D decimal digits. Since the number of arithmetic operations for the recursive 
evaluation increases with increasing «x beyond that required for the asymptotic 
approximation and the auxiliary function, it is efficient to use backwards recursion 
for x < CK and asymptotic approximation for x > CK. 

Tests of the algorithm using values from Table I show that resultant probability 
values are accurate to at least D decimal digits for backward recurrence over 
[a1 + aox — az3/(« + ag)] terms when « < CK and for the normal approximations 
using the corresponding value of C; when x > CK. For other accuracy levels in- 
terpolation should provide useful estimates which may need adjustment to im- 
prove efficiency without loss of desired accuracy. The level of accuracy achievable 
is limited by that of the standard functions for SIN, COS, and SQRT or of the 
auxiliary function, GAUSS or ERF. For lower-accuracy versions little is lost by 
use of a linear bound, p = « + 4(D — 4), but for higher-accuracy versions the 
tighter bounding curve is more efficient. Should very high accuracy be required, 
it would be more efficient to utilize high order terms in the asymptotic series 
[4] to enable reduction of CK. 

For real values of © outside the range (—7z, +7) the result from recursive 
evaluation lies outside the range (0,1), whereas the normalizing approximation 
yields results in the required range but lacks the monotonic increasing property 
appropriate for a cumulative distribution function. It is convenient to extend the 
domain of definition over all real © by treating the angle as reduced modulo 27 
to the range (—7, +7), so that results for both small « and large « remain con- 
sistent with the properties of a probability distribution. With this convention for 
angles in a circle, the probability over an interval (01, 02), evaluated as F'(O.; x) 
— F(01; «), can be negative if the interval includes (2n + 1), in which case 
the correct result is obtained by adding 1. Because accumulated roundoff error can 
produce results lying just outside (0,1) in extreme cases, such results are replaced 
by the limit values 0 or 1. It is also convenient to treat negative values of x as 
zero so that the result (the cumulative uniform distribution if «x < 0) remains 
defined for all real « as well as for all real 6, and thus no error conditions can arise 
from invalid actual parameter values. 

The algorithm is presented in the form of a real-valued FUNCTION VMISES 
(T, VK). T is the real value of the angle © in radians, VK is the real value of 
the concentration parameter «x. This form requires an auxiliary function GAUSS(X) 
having a single real argument and returning the left tail area of the normal dis- 
tribution as a real value in the interval (0,1). A suitable function accurate to 10 
decimal places can be provided by Algorithm CJ39 [1]. For higher-accuracy levels 
the somewhat slower algorithm, ACM Algorithm 304 [5] would return the required 
value with a precision matched to the processor uscd. 

If an auxiliary real function, ERF(X), is supplied instead of GAUSS(X), 
columns 7 to 50 of each of the last three comment cards marked IF ERF must 
replace the statement preceding it, thus providing an appropriate alternative 
version of the function VMISES. 

The backwards recurrence method in this algorithm is considerably faster and 
requires less storage than Algorithm AS 86 [8] which evaluates the von Mises 
distribution with accuracy up to 8D for © values extended to the whole real line. 
The approximation, accurate to 3D, offered for x > 30 in the description of Al- 
gorithm AS 86, is considerably less effective than the asymptotic approximation 
in this algorithm. 

The performance of this algorithm was tested on an IRIS 80 using a Fortran 
compiler with single precision to about 7 decimals and double precision to about 
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16 decimals. The numerical stability of backwards recursive evaluation of sin nO 
and cos nO was tested in single and double precision for p < 50, n = 1, indicating 
accuracy loss of at most 2 decimal digits. To check the backwards recurrence 
method, values of 1 — 2P(0;«) were computed by the algorithm for x = 0(0.2)4 
and © = 0°(5°) 180° and compared with Table 4 of Gumbcl ct al. [6]. Results cor- 
responded within a unit in the last place, except for two misprints in the published 
tables; ®,(a = 10°, « = 1.8) = 0.15740 should be 0.16740 and $.(a@ = 40°, x = 4.0) 
= 0.71123 should be 0.81123. The validity of the asymptotic approximation was 
tested by comparison with results of extensive recursion for a range of values of 
0 and x. Tests with negative and zero values of « and 9 near 0 and 27 and in the 
range (—5z, +57) confirmed performance of the algorithm as specified. 
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ALGORITHM 
FUNCTION VMISES(T, VK) VMI 1¢ 
C VMISES RETURNS THE LEFT TAIL AREA OF THE VON MISES DISTRIBUTION, VMI 20 
C EQUAL TO THE INCOMPLETE MODIFIED BESSEL FUNCTION, OF THE FIRST VMI 3¢ 
C KIND AND ZERO-TH ORDER. VMI 46 
Cc T = ANGLE IN RADIANS, TREATED AS DEVIATION FROM ZERO (MEAN) VMI 5@ 
C REDUCED MODULO 2PI TO THE RANGE (-PI,+PI). VMI 6@ 
C VK = CONCENTRATION PARAMETER, KAPPA. NEGATIVE VALUES ARE VMI 76 
Cc TREATED AS ZERO. VM. 8@ 
C NEEDS AS AUXILIARY ROUTINE ELTHER VMI 9¢ 
C FUNCTION GAUSS(X), RETURNING THE NORMAL DISTRIBUTICN TAIL AREA VMI 14 
C TO THE LEFT OF THE BOUNDING ORDINATE, X, VMI 110 
C OR FUNCTION ERF(X), RETURNING THE ERROR FUNCTION AREA BETWEEN VMI 120 
Cc ZERO AND THE BOUNDING ORDINATE, X, WHERE ERF(-X) = -ERF(X). VMI 130 
Cc IF ERF IS USED THEN EACH OF THE LAST 3 COMMENTS (COLUMNS 7 VMI 14 
C TO 5@ ONLY) MUST REPLACE THE STATEMEMT PRECEDING IT. VMI 150 
DATA PL /3.1415926535898/, TPI /6.283185307176@/ VMI 16¢@ 
C CONSTANTS APPROPRIATE FOR 8 DECIMAL DIGIT ACCURACY. VMI 1706 
DATA Al, A2, A3, A4, CK, Cl /12.06,0.8,8.0,1.0,10%.5,56.0/ VMI 18¢@ 
Z = VK VMI 19¢ 
C CONVERT ANGLE T MODULO 2PI TO RANGE (-PI,+PI). VMI 260 
U = AMOD(T+PI,TPI) VMI 21¢ 
IF (U.LT.@.6) U = U + TPI VMI 22¢ 
Y =U - PI VMI 23 
IF (Z.GT.CK) GO TO 3¢ VMI 24¢ 
v= 0.¢ VMI 250 
IF (Z.LE.@.@) GO TO 2 VMI 260 
C FOR SMALL VK SUM IP TERMS BY BACKWARDS RECURSION. VMI 276 
IP = Z*A2 - A3/(Z+A4) + Al VMI 280 
P = FLOAT(IP) VMI 29¢@ 
S = SIN(Y) VMI 340 
Cc = COS(Y) VMI 310 
Y = Pry VMI 320 
SN = SIN(Y) VML 330 
CN = COS(Y) VMI 340 
R = 0.0 VMI 356 
Z = 2.0/Z VMI 360 
DO 1@ N=2,IP VMI 376 
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1 
20 


C FOR 
30 


49 


P-1.¢ 

SN 
= SN*C - CN*S 
= CN*C + Y*S 

= 1,6/(P*Z+R) 
V = (SN/P+V)*R 
CONTINUE 
VMISES = (U*@.5+V)/PL 
GO TO 4@ 
LARGE VK COMPUTE THE NORMAL APPROXIMATION AND LEFT TAIL. 

24 .O*Z 

c - Cl 

SQRT ((54.0/ (347 .@/V+26.¢-C)-6.G4+C)/6.0) 
QRT ((54.06/(347.6/V+26 .G-C)-6.@4+C) /12.0) IF ERF 
SIN (Y*@.5)*R 

Z¥Z 
*Z*2.Q IF ERE 
V-S+ 3.¢ 

(C-S-S-16.0)/3.@ 

((S+1.75)*S+83.5)/V - ¥ 
VMISES = GAUSS(Z-S/ (Y*Y)*Z) 
VMLSES=ERF (Z~S/ (Y*Y)*Z)*@. 
IF (VMISES.LT.@.@) VMISES 
IF (VMISES.GT.1.@) VMISES 
RETURN 

END 
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ALGORITHM 519 

Three Algorithms for Computing Kolmogorov- 
Smirnov Probabilities With Arbitrary Boundaries 
and a Certification of Algorithm 487 [S14 | 


RALPH KALLMAN 
Ball State University 


Key Words and Phrases: Kolmogorov-Smirnov probabilities, sample distribution function, 
boundary crossing probability 

CR Categories: 5.5 

Language: Fortran 


DESCRIPTION 


Introduction 


Let A(y), B(y) be nondecreasing functions on [0, 1] where B(0) < 0 < A(O), 
Bil) < 1 < A(1). Let G,(y) be the sample distribution function for n independ- 
ent random variables uniform on [0, 1]. We present three methods for computing 
P = Pr {B(y) < Gi(y) < A(y), y € [0, 1}}. The special case where A(y) = 
y+ D, B(y) = y — D has been treated by ACM Algorithm 487 [4]. 


Subroutine RAKK. A Generalization of Massey's Method 


Massey has given a recursion formula [8; 5, p. 341, eq. (11.7.9)] for computing P 
when A(y) = y + k/n, B(y) = y — k/n. This can be generalized to arbitrary 
boundaries as follows. Let y(1, 7), y(2, 7) be the level points of B(y), A(y) for the 
ordinates (7 — 1)/n (eg. A(y(2, 7)) = (7 — 1)/n). If the boundaries are not 
continuous and strictly increasing, let 


y(2,j) = suply € [0, 1]] A(y) < (9 — 1)/n) 
y(1,j) = infty € [0, 1]| Bly) 2 (j — 1)/m} 


for those 7 such that the sup or inf is taken over a nonempty set. Arrange the 
y(k, 7) into a single ordered sequence y(z), 7 = 1,...,m, wherey(1) = 0, 
y(m) = 1 are attached if not already present. Let jt(7) = largest integer 7 such that 
(j — 1)/n < A(y(t) —) and jb(¢) = smallest integer 7 such that (j — 1)/n > 
Biy(i) +), 1 < i < m. Note that if ji(m) < n+ 1, then P = 0. Then define 
jtop(t) = min(jt(z), m + 1), jbot(z) = max(jb(7), 1), 1 < ¢ < m;yjbot (1) = 
jtop (1) = 1;jbot (m) = jtop (m) =n + 1. Then 


m = _ 4) @-5G-D 
P= > a I [y(&) re 
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where the summation is over the index set {j7=(j(1),...,7(m)) |jbot(@) < 
g(t) < jtop(2)}. Note that 7(1)=1. 

The computer program RAKK sums these multinomial probabilities recursively 
by computing W(k, 7) where 


Wi, 1) 1 
W(k, t) » WG,¢ — 1) w@) — 9 — DI V7), 
k = jbot(t),..., jtop(t), 7 = 1,...,m, 


where the summation is over the index set {7|k — 7; > 0,jbot(¢ - 1) <7 < 
jtop(¢ — 1)}. Then P = W(n + 1, m) nl}. 

Because machines with small exponent range on floating numbers cannot ac- 
commodate the array W(-,7) we have split the array into blocks, Each block contains 
the values of W(-, 7) multiplied by a suitably large conversion factor. The recip- 
rocals of these conversion factors are accumulated in TF by subroutine ACCUM; 
to keep the accumulated product TF within range it is multiplied by consecutive 
positive integers, as necessary, with the current value stored in NNN. At the 
conclusion of the program the value of TF is adjusted so that NNN = N and then 
the multiplication by n! in the formula P = W(n + 1, m)n! is accomplished by a 
multiplication by TF. 


Subroutine DURB. Durbin’s Method 


The recursion is on k!a(k), k!8(k) where a, 8 are defined in [1, eqs. (86), (37), 
(40)]. These variables are denoted by ALPHA(k — 1), BETA(k — 1) in our 
program, and the indexing runs through k = 1,...,n + 1. Durbin’s algorithm 
computes the probability that G,(y) crosses a boundary so a subtraction from 1 is 
necessary. This instruction is flagged in the program listing. 


Subroutine EPST. The Epanechnikov, Steck Method 


This method [2, p. 15] is numerically unstable for larger values of n because of 
cancellation of digits in subtractions. Thus we do not include a listing of the com- 
puter program. However, we do include the test results for our implementation of 
this algorithm. 


Organization of Programs 


All three methods accept as inputs the boundary level points y(k, 7) and the sample 
size n. A preliminary computation of these boundary level points is necessary, 
and there must be n + 1 of each. If A(y) > (j — 1)/n for all y € [0, 1], then 
a negative number must be given for y(2, 7) and if B(y) < (gj — 1)/n for all 
y € [0, 1], then a number greater than 1 must be used for y(1, 7). As an example, we 
have included a listing of function PLN which computes P where A, B are (arbi- 
trary) straight lines. As listed, PLN invokes method RAKK; the listing indi- 
cates the change necessary to invoke DURB or EPST. 

Underflow occurs frequently in our programs and the underflow switch, if any, 
on the object machine should be sct to return zero and the underflow diagnostic 
should be suppressed. 


Test Results, Execution Times, and Precision 


The three algorithms were programmed with single precision instructions only 
and were tested on the following machines: (a) DEC 10, (b) IBM 360-50, (c) 
CDC 6400. Single precision for these machines is, respectively, 8, 6, and 14 decimal 
digits and the range on decimal exponents is, respectively, —38 to 38, —75 to 75, 
and —293 to 321. The fortran compilers used were, respectively, FORTRAN 
10/OPT, FORTRAN H(OPT = 2), and FUN. Table I lists the problems tested, 
where A(y) = y + D and B(y) = y — D, and Table II gives the test results. 
If data is missing, the sample size n is too large for the machine and algorithm 
involved. 
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Table I. Problems Tested 


Problem n D P (approximate) 
1 45 .0527 .001 
2 200 .0257 .001 
3 45 .1199 .600 
4 120 .0742 .600 
5 200 .0577 .500 
6 45 .2849 .999 
7 200 . 1368 .999 


Table II. Apparent Precision (in significant decimal digits) of 
Algorithms RAKK, DURB, and EPST 


RAKK DURB EPST 
Machine Machine Machine 
Problem = (a) (b) (c) (a) (b) (c) (a) (b) (c) 
1 7 5 12 4 2 9 7 5 12 
2 6 4 11 — 2 9 4 — 10 
3 6 4 12 6 5 12 3 2 10 
4 6 3 ll — 4 12 — — 7 
5 6 3 11 — 4. 11 — — 4 
6 6 3 11 8 6 12 — — 3 
7 6 2 10 5 12 — — —_— 


Table III. Execution Times (in seconds) of Algorithms RAKK, DURB, and EPST 


RAKK DURB EPST 
Machine Machine Machine 
Problem (a) (b) (c) (a) (b) (c) (a) (b) (c) 
1 15 .53 14 56 3.08 48 .03 .12 .02 
2 1.78 5.53 1.44 — 71.10 11.21 .30 — .24 
3 30 1.05 29 49 2.80 41 05 32 05 
4 1.77 4.98 1.38 —_ 22.72 3.51 — — 24. 
5 4.53 11.40 3.22 — 64.52 10.54 — — 56 
6 73 1.80 58 .38 1.92 29 — —_ 10 
7 10.54 28.72 7.24 19.62 53.70 8.84 — — — 


The precision estimates for machines (a) and (b) are the number of digits which 
agree with the results of machine (c). The estimates for machine (c) were obtained 
by comparing the answers for the various methods. Since DURB computes the 
probability of the complementary event, the final subtraction from 1 accounts 
for the lesser precision of DURB in problems 1 and 2 and its greater precision in 
problems 6 and 7. 

Exccution times for arbitrary boundaries should be comparable to those given 
in Table III, plus the additional time needed to compute the level points y(k, 7). 


Recommendations 


Although EPST is numerically unstable for larger sample sizes, its execution timcs 
are very fast. Thus it would be suitable for numerous computations involving 
small sample sizes with occasional validations by one of the other routines. DURB 
is not suitable for large sample sizes on machincs with small range on decimal 
exponents. Execution times for RAKK are faster. Thus RAKK appears to be the 
preferred choice. This is due largely to the extensive code with its controls against 
underflow, ctc., rather than an intrinsic superiority of the algorithm. 


Certification of Algorithm 487 


Since Algorithm 487 [4], PKS2, treats a special case handled by Algorithms 
RAKK, DURB, and EPST, it may be validated by using the data presented in 
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Table IV. Apparent Precision (in significant decimal digits) of Algorithm PKS2 


Problem Number 


Machine 1 2 3 4 5 6 
(a) en 1 ie So 
(b) 5 — 5 — — 5 


(c) 13+ _— 12-++ 12+ — 13+ 


Table II. The results for the problems discussed are presented in Table IV. If data 
are missing the sample size is too large for the machine involved. (A computation 
of n” is required by PKS2). Although Pomeranz claims precision of 8 decimal 
digits on the CDC 6400 [4], this seems rather modest. There is, apparently, a 
precision of at least 12 decimal digits on the CDC 6400 and a potentially greater 
precision if the double precision value generated by PKS2 is not returned as a 
single precision value. 
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ALGORITHM 
FUNCTION PLN(N, $2, B2, Sl, Bl) PLN 1¢ 
C COMPUTES PROB FOR BOUNDARIES OF FORM S*Y+B. WN IS PLN 2@ 
C SAMPLE SIZE, $2,B2 ARE PARAMETERS FOR UPPER BOUNDARY, PLN 3@ 
C CALLS SUBROUTINE RAKK. TO CALL DURB PLN 4¢ 
C CHANGE AS INDICATED BELOW. PIN 5@ 
DIMENSION YY(2,262), S(2), B(2) PLN 6@ 
C MAX SIZE FOR N IS 26 PLN 70 
$(1) = Sl PLN 8@ 
$(2) = $2 PIN 96 
B(1) = Bl PLN 1¢4¢ 
B(2) = B2 PLN 11@ 
IF (N.GT.@) GO TO 10 PLN 12¢ 
PLN = @. PIN 13¢ 
RETURN PLN 146 
1@ IF (S(1).GE.@.) GO TO 20 PLN 15¢ 
S(1) = @. PLN 16@ 
20 IF (S(2).GE.@.) GO TO 3 PLN 17¢ 
B(2) = S(2) + B(2) PLN 18¢@ 
$(2) = @. PLN 19¢ 
30 Nl = 1 +N PLN 2060 
AN = N PLN 210 
DO 5@ I=1,2 PLN 22 
DO 4@ K=1,N1 PLN 23¢ 
C = FLOAT(K~1)/AN - B(I) PLN 24¢ 
YY(1,K) = -.5 PLN 25¢@ 
IF (C.LE.@.) GO TO 4@ PLN 26@ 
YY(I,K) = 1.1 PLN 27¢ 
IF (S(I).GT.C) YY(I,K) = C/S(I) PLN 28¢ 
4@ CONTINUE PLN 29¢ 
5@ CONTINUE PLN 30@ 


CALL RAKK(N, YY, ANS) PLN 31¢ 
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ana 


WOOO. 3.0 


C 


C 
C 


C 


C 


TO CALL DURB CHANGE PRECEDING STATEMENT TO 
CALL DURB (N,YY,ANS) 
PLN = ANS 
RETURN 
END 


SUBROUTINE RAKK(N, YY, ANS) 

N IS SAMPLE SIZE. YY(2,.),YY(1l,.) 
CONTAIN, RESPECTIVELY, UPPER AND LOWER BOUNDARY 
LEVEL POINTS CORRESPONDING TO @,1/N,2/N,...,1. MUST 
BE N+l OF EACH. ROUTINE ASSUMES THEY ARE NONDECREASING. 

DIMENSION W(2@1,2), YY(2,262), KBLOC(41), FRNG(41,2), SSS(41) 

DATA RNG, RRNG, SQRNG, SQRRNG, MAXNB /1.E292,1.E-292,1.E146, 

* 1.E-146,40/ 
RNG AND RRNG ARE MACHINE DEPENDENT CONSTANTS SELECTED 
SO RRNG=1./RNG G.E. SMALLEST POSITIVE FLOATING 
NUMBER AND RNG L.E. LARGEST POSITIVE FLOATING 
NUMBER OF MACHINE. SQRNG AND SQRRNG ARE SQUARE ROOTS 
OF RNG AND RRNG. 
MAXNB IS THE MAX NUMBER OF BLOCKS INTO WHICH 
W(.,.) WILL BE PARTITIONED. IF MAXNB IS 
INCREASED REVISE DIMENSION STATEMENT ACCORDINGLY. 

Ni=N+1 

1 


Ml = 
W(1,M2) 
NBLOC = 
KBLOC(1) = l 
KBLOG(2) = 2 
FRNG(1,M2) = 1. 
ANS = @. 
IF (NI1.LE.1) RETURN 
YY(2,NI1+1) = 1. 
Yl = @. 
IF ((¥Y(1,1).LE.@.) 
* (YY(1,N1).LE.1.) 
JBOTP = 1 
JTOPP = 1 
JTOPI = 1 
ENTRY POINT FOR SUBSEQUENT ITERATIONS. 
19 JBOT¢ = JBOTP 
JTOP@ = JTOP1 


bo 


= SQRNG 
1 


.OR. (YY(2,N1).GE.1.) .OR. 
.OR. (YY(2,1).GE.@.)) RETURN 


MT = Ml 

Ml = M2 

M2 = MT 

Y@ = Yl 
COMPUTE SUMMATION INDICES, JBOTP,JTOPP FOR NEXT 
ITERATION. 


20 IF (YY(2,JTOPP+1) .GT.Y@) GO TO 3¢ 
JTOPP = JTOPP + 1 
GO TO 2¢ 
3@ Y1 = AMINI(YY(2,JTOPP+1),YY(1,JBOTP) ) 
IF (Y1.GE.1.) GO TO 5¢ 
40 IF (YY(1,JBOTP).GT.Y1) GO TO 60 
JBOTP = JBOTP + 1 
GO TO 4¢ 
5@ Yl = 1. 
SET EXIT FLAG. 
IEXT = 2 
JBOTP = Nl 
60 IF (JBOTP.GT.JTOPP) RETURN 
RETURN WITH ANS=@ SINCE NO PATHS BETWEEN BOUNDARIES. 
JTOP1 = JTOPP 
P = Yl - Y@ 
KBLOC(NBLOC+1) = JTOP1 + 1 
DO 7¢ L=JBOT@, JTOP1 
W(L,M2) = @. 
7@ CONTINUE 
L@ = KBLOC(NBLOC) 
Ll = JTOP@ 
DO 8@ L=L@,L1 


NEXT ITERATION IS FINAL ONE. 
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IF (W(L,M1).GT.SQRRNG) GO TO 8@ 
JTOP@ =L- 1 
GO TO 9¢ 

8¢@ CONTINUE 

99 IF (JBOT@.LT.KBLOC(2)) GO TO 116 


C THE NEXT FEW STATEMENTS ELIMINATE BLOCKS NO 


C 


aan 


C 


C 


LONGER USED. 
DO 10@ I=1,NBLOC 
FRNG(I,M1) = FRNG(I+1,M1) 
KBLOC(IL) = KBLOC(I+1) 
100 CONTINUE 
NBLOC = NBLOC - 1 
CALL ACCUM(RRNG/FRNG(1,M1), TF, NNN) 
GO TO 9¢ 
11@ KBLOC(1) = JBOTO 
MBAV = (MAXNB-NBLOC+1) /2 
IF (P.LE.(1./FLOAT(4*N1))) MBAV = 2 
MBAV = MIN@(MAXNB,NBLOC+MBAV) 
MBAV IS UPPER LIMIT ON NUMBER OF BLOCKS DURING NEXT 
ITERATION. MBAV IS SET TO LIMIT NUMBER OF NEW 
BLOCKS WHEN P IS SMALL. 


CONVI = 1. 
Tl = 1 
Jl=1 


12@ DO 4¢@ I=I1,NBLOC 
KBLI = KBLOC(I) 
IF (1.EQ.11) GO TO 179 
FRNG(I,M2) = AMINI(FRNG(I,M1),1./(SQRNG*W(KBLI-1,M2))) 
CONVI = (CONVI/FRNG(I-J1+1,M1))*FRNG(I,M2) 
IF (J1.EQ.1) GO TO 179 
Kl = KBLOC(I) — KBLOC(I-J1+2) + 1 
K@ = KBLOC(I-1) - KBLOC(I-J1+1) + 1 
IF (K1-KO) 150, 176, 130 
130 KOP1 = KO+1 
DO 149 K=K@P1,KI1 
CONVI = CONVI*P/FLOAT(K) 
146 CONTINUE 
GO TO 1790 
150 KIP1 =K1 +1 
DO 16¢ K=K1P1,K@ 
CONVI = CONVI*FLOAT (K)/P 
166 CONTINUE 
176 IF (CONVI.GT.RRNG) GO TO 21¢ 
DO 199 J=J1,J11 
CHANGE UPPER LIMIT IF EARLY EXIT FROM PREVIOUS LOOP 
CONVI = FRNG(I,M2) *RNG 
K@ = MAXO(1,KBLOC (I-1) -MIN@(JTOP@+1 ,KBLOC (I-.I+1) )+2) 
Kl = KBLOC(IL) - MIN@(JTOP@+1,KBLOC(I-J+1)) + 1 
DO 180 K=K@,K1 
CONVI = CONVI*P/FLOAT(K) 
18¢ CONTINUE 
CONVI = SSS(J)*CONVI 
IF (CONVI.GT.RRNG) GO TO 2¢ 
196 CONTINUE 
GO TO (16, 449), IEXT 
200 Jl=I+1 
216 DO 399 J=J1,I1 
LFG = 1 
LFG=2 IF NEXT ITERATION ON J BECOMES NECESSARY. 
LB1 = KBLOC(1) 
K@l = KBLOC(I) - KBLOC(I-J+1) + 1 
S = CONVI 
IF (J.EQ.J1) GO TO 240 
IF (TMLT) 220, 460, 230 


226 S = ~TMLT*FRNG (I-J+2 ,M1) 
IF (S.GT.RRNG) GO TO 24¢@ 
230 S = TMLT* (FRNG(I-J+2,M1)*RNG) 
240 K@ = MAX@(KBLOC (I) -MIN@(KBLOC (I-J+2)-1, JTOP@)+1,1) 
Ki = KBLOC(I+1) - KBLOC(I-J+1) 
TMLT = @. 
RRNGS = l. 
IF (S.LT.@.) RRNGS = -RRNG 
SSS(J) = 8 
DO 37@ K=K@,K1 
LDF = 1-K 


699 
700 
710 
72¢ 
730 
740 
750 
760 
770 
780 
790 
800 
81¢ 
82¢ 
830 
849 
850 
860 
879 
880 
890 
900 
910 
92¢ 
93 
940 
950 
960 
970 
980 
990 
1900 
1910 
1920 
1030 
16490 
1065¢ 
1060 
1070 
1980 
1996 
1196¢ 
111¢@ 
112¢ 
1130 
1146 
115¢@ 
116@ 
1170 
1180 
1199 
1206 
121¢ 
1229 
1230 
1240 
1256 
126¢ 
1270 
1280 
1290 
13060 
1310 
1320 
1330 
1340 
1350 
1360 
1370 
138¢ 
1390 
1400 
1416 
142¢ 
1430 
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* 


LB 


250 
LBL = L 


MAX@(KBLOC (I) ,KBLOC (I-J+1)-LDF,LB1) 
LT = MIN@(KBLOC (I+1)-1,MIN@(JTOPO ,KBLOC (I-J+2)-1)-LDF) 
IF (LB.GT.LB1) LFG = 2 
IF (LB.GIT.LT) GO TO 270 
DO 26@ L=LB,LT 

IF (W(L,M2) .EQ. ((W(L+LDF,M1)*RRNGS)*S+W(L,M2))) GO TO 


C WHEN THE SUMMANDS BECOME SO SMALL THAT THE VALUE OF 


C W(L,M2) IS UNCHANGED LBl IS INCREASED. 
C FURTHER ADDITIONS TO SUCH W(L,M2). 


250 


260 
270 


280 
290 
300 
319 
320 
330 
340 


350 


GO TO 290 


THIS PREVENTS 


IF (W(L,M2).GT.RRNG) GO TO 26¢ 


IF (K-K@1) 340, 340, 28¢ 


CONTINUE 
LB1 = LT + 1 


IF ((LB1.NE.KBLOC(I+1)) .OR. (K.LE.K@1)) GO TO 340 


Jill = J 


IF (W(KBLI,M2) .LE.RRNG) LFG = 2 


GO TO (400, 380), LFG 
IF (S) 360, 380, 326 
DO 31% L=LB1,LT 


W(L,M2) = (W(L+LDF,M1)*RRNGS)*S + W(L,M2) 


CONTINUE 
GO TO 34¢ 


DO 33@ L=LB1,LT 


W(L,M2) = W(L+LDF,M1)*S + W(L,M2) 


CONTINUE 
T=S8 


S = S*P/FLOAT(K) 

IF (S) 360, 350, 360 

IF (T.LE.@.) GO To 38¢ 

S = -(T*RNG)*P/FLOAT(K) 
RRNGS = -RRNG 

C THE NEGATIVE BIT IN S,TMLT IS USED TO 


C INDICATE ITS VALUE IS RNG TIMES THE USUAL VALUE. 


360 


IF (K.EQ.K@1) TMLT = S 


C THE ITERATION ON K MUST CONTINUE UNTIL TMLT IS 


C SET. 
370 
380 
399 
400 


C CREATE NEW BLOCK IF NECESSARY. 


410 


TMLT USED IN NEXT ITERATION ON J. 


CONTINUE 
Jll = J 
CONTINUE 
CONTINUE 


IF (NBLOC.GE.MBAV) GO TO (106, 440), IEXT 


Ll = KBLOC(NBLOC+1) - KBLOC (NBLOC) 


DO 41@ L=1,L1 


LL = KBLOC(NBLOC+1) - L 
IF (W(LL,M2) .GE.SQRRNG) GO TO 42¢ 


CONTINUE 


420 IF (LL.EQ.JTOP1) GO TO (1@, 440), IEXT 


430 


440 


450 
460 


470 
480 


490 
5060 


KBLOC (NBLOC+2) = KBLOC (NBLOC+1) 
KBLOC (NBLOC+1) = LL + 1 


NBLOC = NBLOC + 1 

L@ = KBLOC(NBLOC) 

DO 436 L=LO,JTOP1 
W(L,M2) = @. 

CONTINUE 

Il = NBLOC 


FRNG(NBLOC,M2) = 1. 


CONVI = @. 
GO TO 12¢ 


CALL ACCUM(W(N1,M2), TF, NNN) 
CALL ACCUM(SQRRNG, TF, NNN) 
IF (NBLOC.EQ.1) GO TO 460 


DO 45@ I=2,NBLOC 


CALL ACCUM(RRNG/FRNG(I,M2), TF, NNN) 


CONTINUE 
ANS = TF 


IF (N-NNN) 4706, 490, 5060 


DO 486 J=N1,NNN 


ANS = ANS/FLOAT (J) 


CONTINUE 
RETURN 
NNN = NNN + 1 


1440 
14590 
146 
147@ 
148@ 
149¢ 
1500 
1519 
152¢ 
1530 
154¢ 
1550 
1560 
1570 
1580 
1596 
1600 
1610 
1620 
1630 
1640 
165@ 
1660 
1670 
168¢@ 
169¢ 
17060 
1710 
1720 
1730 
1740 
175@ 
176¢ 
1770 
1780 
179¢ 
18060 
181¢ 
1826 
183@ 
184¢ 
1850 
186@ 
1870 
1880 
189¢ 
1900 
191¢ 
192¢ 
1930 
1949 
1950 
1960 
1970 
1980 
1996 
2000 
2010 
2020 
2630 
2646 
2050 
2060 
2070 
2680 
2090 
2100 
2119 
2120 
2130 
214¢ 
215¢ 
216¢ 
2170 
2180 
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DO 51@ J=NNN,N 


ANS = ANS*FLOAT (J) 


51@ CONTINUE 
RETURN 
END 


SUBROUTINE ACCUM(F, TF, NNN) 


C THIS SUBROUTINE ANCILLARY TO RAKK AND ACCUMULATES THE 
C MULTIPLIERS USED TO KEEP W(.,.) IN RANGE. 

TF = TF*F 

19 IF ((TF.GT.1.) .OR. (TF.EQ.@.)) RETURN 

NNN = NNN + 1 


Qn ana a 


Q 


19 


TF = TF*FLOAT (NNN) 
GO TO 1@ 
END 


SUBROUTINE DURB(N, YY, ANS) 
DURBINS METHOD. J.APPL.PROB., 8(1971), PP431-453, 
FORMULAS (36),(37), (4). 
N IS SAMPLE SIZE. YY(2,.),YY(1,.) 
CONTAIN, RESPECTIVELY, UPPER AND LOWER BOUNDARY 
LEVEL POINTS CORRESPONDING TO @,1/N,2/N,...,1. MUST 
BE N+l OF EACH. ROUTINE ASSUMES THEY ARE NONDECREASING. 
DIMENSION ALPHA(20@1), BETA(2@1), YY(2,2@2) 
DIMENSION STATEMENT PERMITS MAX SAMPLE SIZE OF 20¢@ 
Nl =N+1 
ANS = @. 
IF ((YY(1,1).LE.@.) .OR. (YY(2,N1).GE.1.) .OR. 


* (YY(1,N1).LE.1.) .OR. (YY(2,1).GE.@.)) RETURN 


Ip = 1 
DO 2@ I=1,N1 


IF (YY(2,1).LT.@.) GO TO 10 
IP =I 

GO TO 3¢ 

YY(2,1) = @. 


2¢ CONTINUE 
3@ DO 40 I=1,N1 


IF (YY(1,I).LE.1.) GO TO 4@ 
YY(1,I) = 1. 


4Q@ CONTINUE 


ALPHA(L) = @. 
BETA(1) = l. 
DO 120 K=2,N1 


ALPHA(K) = YY(2,K)**(K-1) 
IF (IP.GT.(K-l1)) GO TO 60 
COMB = l. 
tl = K- IP 
DO 5@ I=l1,I1l 
COMB = COMB*FLOAT (K-L) /FLOAT (I) 


C COMB IS BINOMIAL COEFFICIENT K-1 OVER I-1. 


50 
60 


* 


* 


ALPHA(K) = ALPHA(K) - ALPHA(K-1)* (YY(2,K)-YY(2,K-1))**1* 
COMB 
CONTINUE 
COMB = l. 
DO 70 J=1,N1 
IF (YY(2,K).LE.YY(1,J)) GO TO 8@ 
ALPHA(K) = ALPHA(K) - BETA(J)*(YY(2,K)-YY(1,J))**(K-J)* 
COMB 


C COMB IS BINOMIAL COEFFICIENT K-1 OVER J-1l. 


70 
80 


& 
C COMB IS BINOMIAL COEFFICIENT K-1 OVER I-1l. 


96 


COMB = COMB*FLOAT (K-J) /FLOAT (J) 
CONTINUE 
BETA(K) = YY(1,K)**(K-1) 
IF (IP.GT.K) GO TO 10¢ 
COMB = 1. 
Il=K-IP+1 
DO 9 I=1,I1 
BETA(K) = BETA(K) - ALPHA(K-I+1)* (YY (1,K)-YY(2,K-I+1) )** 
(1-1) *COMB 


COMB = COMB*FLOAT (K-I) /FLOAT (I) 
CONTINUE 
COMB = l. 


ACC 


DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
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190 KML =K-1 
DO 110 J=1,KM1 
IF (YY(1,J).EQ.1.) GO TO 12@ 
C COMB IS BINOMIAL COEFFICIENT K-1 OVER J-1l. 
BETA(K) = BETA(K) - BETA(J)*(YY(1,K)-YY(1,J))**(K-J)*COMB 
COMB = COMB*FLOAT(K-J) /FLOAT (J) 
110 CONTINUE 
126 CONTINUE 
COMB = 1. 
Il = Nl -IP+1 
DO 13@ I=1,11 
ANS = ANS + (1.-YY(2,N1-I+1) )** (1-1) *ALPHA (N1-I+1)*COMB 
COMB = COMB*FLOAT(N1-I) /FLOAT(I) 
130 CONTINUE 
COMB = 1. 
DO 149 J=1,N1 
IF (YY(1,J).EQ.1.) GO TO 15@ 
ANS = ANS + (1.-YY(1,J))** (N1-J) *BETA (J) *COMB 
C COMB IS BINOMIAL COEFFICIENT N OVER J-1l. 
COMB = COMB*FLOAT(N1-J) /FLOAT (J) 
149 CONTINUE 
C FOR PROB OF COMPLEMENTARY EVENT CHANGE NEXT STATEMENT TO 
C 15@ CONTINUE 
15@ ANS = 1. - ANS 
RETURN 
END 


DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 
DUR 


570 
580 
590 
600 
619 
620 
630 
646 
65¢ 
660 
670 
680 
690 
700 
710 
720 
730 
740 
750 
760 
770 
780 
790 
800 
819 
820 
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ALGORITHM 520 


An Automatic Revised Simplex Method for 
Constrained Resource Network Scheduling [H| 


JAN WEGLARZ, JACEK BLAZEWICZ, WOJCIECH CELLARY, and 
ROMAN SLOWINSKI 


Technical University of Poznan, Poland 


Key Words and Phrases: resource allocation, activity networks, linear programming 
CR Categories: 3.31, 4.32, 5.41, 8.3 
Language: Fortran 


DESCRIPTION 


Purpose 


Subroutine ARSME solves a resource constrained, network scheduling problem 
for the case in which activities may be arbitrarily interrupted and restarted later 
with no increase in activity duration. The number of resource types is not a limit- 
ing factor in our procedure. The amount of any one resource available at any 
moment is constant. We shall use the “activity-on-are”’ network representation, 
under the commonly imposed assumption that the network contains no directed 
cycles and has only one “beginning” and only one “terminal” node (event). It is 
further assumed that the network nodes (events) are ordered in such a way that 
node 7 precedes node J, if 7 < j. Such an ordering is always possible and it induces 
an ordering among the arcs (activities). 

Optimal approaches to resource constrained, network scheduling problems where 
activities can require more than one resource type are presented in [1, 4]. Both 
methods assume integer durations of activities, and the method presented in [1] 
divides activity durations into unit intervals. Both methods can handle networks 
with up to about 30 activities and 3 resource types. 

Subroutine ARSME is constructed in such a way that its storage requirements 
are minimal, a fact which permits the solution of problems for very large net- 
works with many resource types. Moreover, an optimal solution can be obtained 
in a shorter time when relatively smaller amounts of the resources are available 
than when resources are less limited. 

Let the number of activities be equal to M and the number of resource types 
be equal to RT. For activity 7 (j = 1,2,..., MM) andresourcek (k = 1,2,..., RT) 
the following variables are given: activity duration d,; activity resource require- 
ment Ry, ic. the amount of resource k required by activity 7; resource limit 
RL, , i.e. the amount of resource k available at any moment. 

The solution of our problem consists of the assignment of time intervals to re- 
source feasible sets of activities (i.e. activities which can be performed simul- 
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taneously and not violate resource limits), in order that the completion time of 
the project be minimal. For this reason, it is necessary to generate all such sets 
and to solve the ensuing linear programming (LP) representation of the problem. 
LP variables are the durations assigned to these activity sets. The optimal dura- 
tions obtained are ordered according to the network structure. In similar fashion 
we obtain the time intervals making up the optimal schedule. 

As input data for subroutine ARSME, it is necessary to provide the fellowmne 


data: 
M number of activities in the network; 
M1 dimension limit equal to M + 1; 
M2 dimension limit equal to 2M + 1; 
ME dimension limit of vector E (see the discussion below) ; 
ND number of nodes; 
RT number of resource types; 
NI declared limit of the number of iterations, usually taken as 2M 


(the subroutine ends computations if the optimum solution is not 
found in NI iterations) ; 

NS(M2) network structure vector containing the consecutive activities 
as ordered pairs of nodes; no initial valuc is required for element 
NS(M2); 

X (M1) vector of activity durations; 

RL(RT) vector of resource limits; 

R(M, RT) matrix of resource requirements. 


The value of ME is taken to be (M1 XNTI) if M1 XNI does not excecd the avail- 
able amount of primary storage; otherwise, it is taken as the available limit of pri- 
mary storage. 

When the optimal solution is obtained, the optimal schedule (i.c. the sets of 
activities together with corresponding time intervals) are printed on the line 
printer. On the other hand, if the optimal solution is not reached in the declared 
number of iterations NJ, then the message ‘number of iterations greater than 
NI” is printed. In this case, the computations should be repeated for a greater 
value of NI. 

As an example let us consider the network shown in Figure 1. Input data are: 
M = 5; M1 = 6; M2 = 11; ME = 60; ND = 4; RT = 3; NI = 10;NS = 
(1, 2, 1, 3, 2, 3, 2, 4, 3, 4]; X = [L.0, 2.0, 3.0, 2.0, 2.0]; RL = [5.0, 5.0, 3.0]; 


2.0, 2.0, 1.0 
0.0, 2.0, 1.0 
R = |2.0, 1.0, 3.0). 
3.0, 3.0, 3.0 
1.0, 1.0, 0.0 


? 


~y 


As an optimal schedule, ARSME yields 


time intervals activities 
123 4 5 
0.0-1.0 11000 
1.0-2.0 01000 
2.0-5.0 00100 
5.0-7.0 000141 
7.0-7.0 00001 


with Tmin = 7. This means that, in the optimal schedule, activitics 1 and 2 should 
be performed simultaneously in the time interval (0.0, 1.0), activity 2 in the time 
interval (1.0, 2.0), ete. 


Method 


Subroutine ARSME solves an LP problem which is formulated as follows. 
Let S; denote the set of all activities which may be performed between the oc- 
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currence of node / and J + 1. Such sets will be called main sets. Let us number 
from 1 to N the resource feasible sets, i.e. those subsets of the main sets and those 
main sets for which the resource requirements do not exceed any resource limits. 

Now, let Q; denote the set of all numbers of resource feasible sets in which ac- 
tivity 7 may be performed, and let x; denote the duration of sct 7. Thus the LP 
problem is obtained: 


minimize 
N 
= > Ui 
i=1 
subject to 
Dt = dj (j = 1,2,..., M) (1) 
tEQ; 
or in matrix notation, 
Ax=d (2) 


where A is the matrix of coefficients 


ee {6 if i € Q;; 


0 otherwise. 


Obviously, columns of matrix A correspond to resource feasible scts. 

When applying the simplex method directly to this problem, one must somehow 
store matrix A, which is a very large matrix for even small problems. This greatly 
constrains the size of the problems which can be solved. 

Subroutine ARSME eliminates the above storage problem by utilizing the re- 
vised simplex method [2] in which elements of matrix A are not transformed. 
This method is computationally profitable for sequencing problems, since in prac- 
tical ones, the number of variables is greater than three times the number of 
constraints [5]. The specific version used is based upon the product form of the 
inverse [2]. 

The first basic feasible solution to the problem is known in advance. It consists 
of M, 1-element sets (consecutive performance of all activities). 

Taking advantage of the special structure of the problem, a subroutine GEN 
has been developed which automatically generates the consecutive columns of ma- 
trix A (i.e. the resource feasible sets). An important feature of this subroutine 
is that at every moment only one main set and only one of its resource feasible 
subsets (which is actually needed in the simplex procedure) are stored. This allows 
one to solve problems of larger dimension than otherwise possible and of course 
radically simplifies the preparation of input data. 

Subroutine GEN generates main sets S,, Se,..., Syn using the network 
structure vector. When a single main set has been generated, the generation of its 
resource feasible subsets follows. For this purpose, so-called primary subsets are 
constructed, from which resource feasible subsets are created by adding activities 
from the main set. The first primary subset contains all the activities of the main 
set which also cornposed previously generated main sets, as well as one new ac- 
tivity. New primary subsets are created either when the last activity from the 
main set has been added, or when the generated subset is found to be unfeasible. 
In the first case, the last activity of the last generated subset is rejected and the 
penultimate one is replaced by the next from the main set. In the second case, the 
last activity of the unfeasible subset is replaced by the next from the main set. The 
number of sets in which resource feasibility is checked is always minimal and is 
usually much smaller than the total number of sets of activities which may be 
performed simultancously. This follows from the construction of the primary sub- 
sets and from the fact that activities in the main sets are ordered by the sub- 
routine ORDSNE in a unique fashion. 

After generating each resource feasible set ARSME, together with subrou- 
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tine KFIND, checks, according to the simplex procedure, whether the set is 
good enough to be in the optimal solution. This proceedure is repeated until the 
optimal solution is obtained. Then subroutine ORDSNE orders the sets com- 
posing the optimal solution, and subroutine PRISET prints out the results. 

The parameters of ARSME, which are associated with the applied version of the 
simplex procedure, are as follows: 


U, D vector used for finding vectors introduced into, and eliminated from, the 
basis, respectively ; 


E vector of the inverse; 
LO vector of the indices of vectors eliminated from the basis in successive 
iterations; 


IBV vector of indices of the basis vectors. 
(Other parameters are subsidiary ones). 


Timing Tests 


A comparison of the computation time required by subroutine ARSME and other 
methods for solving the constrained resource network scheduling problem is not 
very helpful because of the different assumptions made in these methods. However, 
as an example, a comparison of computation times is shown in Table I for the two 


Table I 


Davis method Patterson method ARSME 


Optimal Time to Optimal Time to Optimal Time to 
Resource schedule optimal schedule optimal schedule optimal 


Problem limits RE, length solution* length solutiont length§ solutiont 

1. Davis and 5, 5,3 7 7 1.57 7 0.81 
Heidorn 

2. Moodie and 5 8 2.00 8 1.35 8 1.20 
Mandeville 

3. Moodie and 4 11 11 3.78 10.5 1.14 
Mandeville 


* TBM 7094 CPU time in seconds. 

t IBM 360/67 CPU time in seconds. 

t ICL 1900 CPU time in seconds. 

§ Because of the provision for job splitting in our procedure, optimal schedule lengths may 
differ from those reported by Davis and by Patterson. 


3(1) 


RL = (5) 
or RL = (4) 


Fig. 2. Network used in problem formulated by Moodie and Mandeville [3] 
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simple networks described in [1, 3] and shown in Figures 1 and 2. One may notice 
that, for problem 3, ARSME finds a solution with a lower value of the objective 
function, because of the assumption of the arbitrary splitting of activities. 

All tests have been made on an ODRA-1305 computer (license ICL-1900). 
Computation times for networks of about 20 activities vary from about 15 seconds 
to 3 minutes; for networks of about 50 activities, from 5 minutes to 25 minutes; 
and for networks of about 100 activities, from 20 minutes to 90 minutes. Variance 
in computation times for a given size of network appears to be primarily a function 
of the number of network nodes and the values of resource limits. 
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ALGORITHM 


[Only that portion of the listing which is the introductory comment section ex- 
plaining subroutine ARSME is printed here. The complete listing, including sub- 
routines GEN, KFIND, PRISET, and ORDSNE, is available from the ACM 
Algorithms Distribution Service (sec inside back cover for order form), or may 
be found in ‘Collected Algorithms from ACM.?] 


SUBROUTINE ARSME(M, Ml, M2, ME, ND, RT, NI, NS, X, R, RL, ARS 10 

* IBV, LO, E, U, D) ARS 20 

C PURPOSE ARS 30 
C TO SOLVE A MULTIPLE-RESOURCE NETWORK SCHEDULING PROBLEM -PREEMPTIVE ARS 4¢ 
C CASE BY THE REVISED SIMPLEX METHOD WITH THE PRODUCT FORM OF THE ARS 50 
C INVERSE. *ACTIVITIES-ON-ARCS* NETWORK REPRESENTATION IS USED. ARS 6@ 
C THIS IS THE PRIMARY SUBROUTINE AND IT COORDINATES THE SPECIAL ARS 70 
C PURPOSE SUBROUTINES GEN,KFIND,PRISET,ORDSNE. ARS 8@ 
C THE SUBROUTINE USES A LINE-PRINTER AS PROGRAMMING UNIT 2 AND ARS 90 
C MAGNETIC TAPES AS PROGRAMMING UNIT 3. ARS 1060 
C THE MAGNETIC TAPES ARE USED ONLY IF THE INVERSE EXCEEDS THE ARS 110 
C DIMENSION LIMIT OF VECTOR E. ARS 120 
C DESCRIPTION OF PARAMETERS ARS 130 
c OM NUMBER OF ACTIVITIES ARS 14@ 
C Ml DIMENSION LIMIT OF VECTORS IBV,U,D AND X, EQUAL TO Mtl ARS 150 
C M2 DIMENSION LIMIT OF VECTOR NS, EQUAL TO M+M+1 ; ARS 160 
C ME DIMENSION LIMIT OF VECTOR E ARS 1706 
C ND NUMBER OF NODES ARS 180 
C RT NUMBER OF RESOURCE TYPES ARS 190 
C NI DECLARED LIMIT OF THE NUMBER OF ITERATIONS ( ABOUT 2%*M ) ARS 20 
C NS NETWORK STRUCTURE VECTOR CONTAINING THE CONSECUTIVE ACTIVITIES ARS 219 
C AS ORDERED PAIRS OF NODES. ARS 220 
Cc NO INITIAL VALUE IS REQUIRED FOR ELEMENT NS(M2). ARS 230 
Cc x VECTOR OF ACTIVITY DURATIONS ARS 240 
Cc oR MATRIX OF RESOURCE REQUIREMENTS ARS 250 
C RL VECTOR OF RESOURCE LIMITS ARS 260 
Cc uUC£ VECTOR OF THE INVERSE ARS 270 
C U,D VECTORS USED FOR FINDING VECTORS INTRODUCED INTO AND ARS 280 
Cc ELIMINATED FROM THE BASIS RESPECTIVELY ARS 290 
C LO VECTOR OF THE INDICES OF VECTORS ELIMINATED FROM THE BASIS IN ARS 30 
C SUCCESSIVE ITERATIONS ARS 310 
C IBV VECTOR OF INDICES OF THE BASIC VECTORS ARS 320 
C AS INPUT DATA PROVIDE M,M1,M2,ME,ND,RT,NI,NS,X,R,RL. ARS 330 
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INTEGER RT, RTl ARS 340 
LOGICAL PRE, PROC ARS 35@ 
DIMENSION NS(M2), IBV(M1), LO(NI), E(ME), U(M1), D(M1), ARS 360 

* X(M1), R(M,RT), RL(RT) ARS 370 

C FOR SOME COMPILERS OF FORTRAN THE DIMENSION LIMIT OF A MATRIX MUST ARS 38@ 
C BE GREATER THAN 1, THEN IF RT IS TO BE EQUAL TO 1, MAKE RT=2 AND ARS 39@ 
C RL(2)=¢ ARS 4@@ 
PROC = .FALSE. ARS 41¢ 

PRE = .TRUE. ARS 42@ 

RT1 = RT ARS 43¢ 

IF (RL(RT).EQ.@.) RTL = RT - 1 ARS 446 

LG = @ ARS 45@ 

IT = @ ARS 46@ 

IK = @ ARS 47@ 

TH2 = @ ARS 48@ 

IH = 1 ARS 490 

JP = 1 ARS 500 

ND = ND - 1 ARS 510 
NS(M2) = NS(M2-1) + 1 ARS 52¢ 

IH1l = ME/M1 ARS 53@ 

RR = @. ARS 54@ 

DO 1@ I=1,M ARS 55@ 

RR = RR + X(I) ARS 56¢@ 

10 CONTINUE ARS 570 
X(M1) = -RR ARS 58@ 

C CHECK IF THE RESOURCE REQUIREMENTS FOR ANY TYPE OF RESOURCE ARE ARS 59@ 
C EQUAL TO EACH OTHER. IF SO, CALCULATE IP IT IS THE MAXIMUM NUMBER ARS 600 
C OF ACTIVITIES WHICH MAY BE PERFORMED SIMULTANEOUSLY. ARS 61¢ 
IP = 99999 ARS 626 

DO 3@ J=1,RT1 ARS 63@ 

P = R(1,J) ARS 64 

DO 2@ I=2,M ARS 65¢ 

IF (P.NE.R(I,J)) GO TO 4¢ ARS 660 

26 CONTINUE ARS 67@ 
IF (P.LT.@.000001) GO TO 3¢ ARS 68¢@ 

I = (RL(J)+.000@1)/P ARS 69¢ 

IF (IP.GT.I) IP = I ARS 76@ 

3@ CONTINUE ARS 710 
IF (IP.NE.99999) PROC = .TRUE. ARS 72@ 

49 D(M1) = @. ARS 73@ 
C CALCULATE VECTOR U ARS 74@ 
DO 5@ I=1,M ARS 75@ 
U(I) = @. ARS 76¢ 

5@ CONTINUE ARS 770 
U(M1) = 1. ARS 78@ 

MF = LH*M1 ARS 799 

IF (LG.EQ.@) GO TO 8@ ARS 86 

LG = - ARS 810 

JK = IT ARS 82¢ 

JP = IH2 + 1 ARS 83¢ 

GO TO 8@ ARS 84¢@ 

60 LG = 1 ARS 850 
JK = IH2 ARS 86@ 

7@ IF (JK.LT.IH1) GO TO 13@ ARS 87@ 
BACKSPACE 3 ARS 88¢@ 
BACKSPACE 3 ARS 89¢ 
READ (3) E ARS 9¢¢ 

MF = IHI1*MI1 ARS 91@ 

JP = JP - IHl ARS 926 

86 J = JK ARS 93@ 
99 IF (J.LT.JP) GO TO 119 ARS 94¢ 
MF = MF - Ml ARS 95¢@ 

TH = @. ARS 96¢@ 

DO 10@ I=1,M1 ARS 97@ 

MQ = MF+I1 ARS 98¢ 

TH = TH + U(1)*E(MQ) ARS 999 

106 CONTINUE ARS 10600 
MQ = LO(J) ARS 161¢ 
U(MQ) = TH ARS 1620 
J=J-1 ARS 1630 

GO TO 9¢ ARS 1040 

116 IF (LG) 60, 13¢, 120 ARS 1050 
126 JK = JK ~ IHI1 ARS 1660 
GO TO 79 ARS 1679 


C FIND K, I.E. THE INDEX OF THE NEW OPTIMAL BASIC VECTOR ARS 1908¢ 


COLLECTED ALGORITHMS (cont.) 


13@ CALL GEN(PROC, PRE, .FALSE., M, Ml, M2, ND, K, J, RT, RTl, 


* IP, NS, LBV, LO, U, D, R, RL) 
C CHECK THE SOLUTION OPTIMALITY CRITERION 
IF (D(M1).LE.(-0.96001)) GO TO 23@ 
C PRINT THE RESULTS OF ARSME 
X(M1) = -X(M1) 
WRITE (2,99999) X(M1) 
CALL ORDSNE(.TRUE., M, IBV, X) 
DO 140 I=2,M 
X(I) = X(I) + X(I-1) 
149 CONTINUE 
eae 
K = 44 
15@ IF (M.LT.K) K = M 
Le 
JK = 1 
IF (J.GT.1) JK = K - 43 
DO 16@ I=JK,K 
LO(I) = 1 
16@ CONTINUE 
WRITE (2,99986) 
Jk = J 
IF (J.GT.4) JK = 4 
GO TO (186, 190, 206, 210), JK 
17@ WRITE (2,99987) 
IF (K.EQ.M) RETURN 


GO TO 15¢ 
18 IF (M.GE.16) WRITE (2,99997) (LO(I),I=1@,K,2) 


IF (K.LT.8) JK =K 
WRITE (2,99996) (LO(I),I=1,K,2) 
WRITE (2,99995) (LO(I),I=2,JK, 2) 
WRITE (2,99988) 
GO TO 22¢ 
199 IF (M.GE.46) WRITE (2,99994) (LO(I),1=46,K, 2) 
WRITE (2,99993) (LO(I),1I=45,K, 2) 
WRITE (2,99988) 
GO TO 22@ 
200 IF (M.GE.9@) WRITE (2,99992) (LO(I),I=9@,K,2) 
WRITE (2,99991) (LO(1I),1=89,K, 2) 
WRITE (2,99988) 
GO TO 22¢ 
219 IF (M.GE.134) WRITE (2,9999@) (LO(I),I=134,K,2) 
WRITE (2,99989) (LO(I),I=133,K, 2) 
WRITE (2,99988) 


22@ CALL GEN(PROC, .TRUE., .TRUE., M, Ml, M2, ND, K, J, RT, RTI, 


* IP, NS, IBV, LO, U, X, R, RL) 
GO TO 179 

230 TH = 10.E7@ 
IF (.NOT.PRE) GO TO 25@ 


C IN THE FIRST ITERATION 
PRE = .FALSE. 
IT = 
JK = 1 
DO 24@ I=1,M 
IF (D(I).EQ.0.9 .OR. TH.LE.X(I)) GO TO 249 
TH = X(I) 
L = 7 
24@ CONTINUE 
LO(1) = L 
GO TO 38¢ 
25@ IF (LG.EQ.6) GO TO 28@ 
LG = 51 


JK = IHl 
260 IF (JK.GT.1IH2) GO TO 33@ 
270 JP = JP + IH 


READ (3) E 
280 MF = -Ml 
J = JP 


290 IF (J.GT.JK) GO TO 31¢ 
MF = MF + Ml 


FIND LO(1), I.E. THE INDEX OF THE VECTOR ELIMINATED FROM THE BASIS 


199¢ 
1100 
111¢ 
112 
113@ 
114¢ 
1150 
1160 
1170 
1180 
119@ 
12060 
1210 
1220 
1230 


| 1246 


125@ 
126¢ 
127@ 
128¢@ 
1290 
130¢ 
131¢ 
132¢ 
1330 
134¢ 
135¢ 
1360 
137 
138 
1390 
1460 
1416 
142¢ 
1430 
1440 
1450 
1469 
1470 
148¢ 
1490 
1500 
151@ 
152¢ 
1530 
154¢ 
155¢ 
1560 
1570 
158¢ 
159¢ 
16060 
1619 
162¢ 
163 
1640 
165@ 
1660 
1670 
1680 
1690 
17060 
171¢ 
1726 
173@ 
174¢ 
175¢@ 
176¢ 
1779 
178¢ 
1790 
1800 
181¢ 
1826 
1830 
1849 
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COLLECTED ALGORITHMS (cont.) 


C CALCULATE VECTOR D 


Cc 
C 


C 


L = LO(J) 
RR = D(L) 
DO 346% I=1,M 
MQ = MF + 1 
D(I) = D(I) + RR*E(MQ) 
3006 CONTINUE 
D(L) = D(L) - RR 
J=JI+1 
GO TO 290 
310 IF (LG) 326, 340, 340 
320 JK = JK + IH] 
GO TO 260 
33@ JK = IH2 + IH 
LG = 1 
GO TO 270 
INCREASE THE NUMBER OF ITERATIONS IN THE ITERATION COUNTER 
3490 IT = IT+ 1 
IF (IT.GT.NI) WRITE (2,99998) 
IF (IT.GT.NL) STOP 
IH = IH + 1 
IF (IH.LE.IH1) GO TO 36¢@ 
IF (LG.NE.@) GO TO 35¢@ 
REWIND 3 
WRITE (3) E 
LG = -l 
350 IH = 1 
IH2 = IH2 + IH1 
360 IF (LG.EQ.@) JK = IH 
FIND LO(IT), I.E. THE INDEX OF THE VECTOR ELIMINATED FROM THE 
BASIS I ITERATION IT. 
DO 370 I=1,M 
IF (D(I).LE.@.) GO TO 37@¢ 
RR = X(1)/D(I) 
IF (TH.LE.RR) GO TO 3706 
TH = RR 
a | 
370 CONTINUE 
LO(IT) = L 
CALCULATE VECTORS E AND X 
380 MF = IH*M1 - M1 


MQ = MF +L 
RR = 1./D(L) 
E(MQ) = RR 
TH = X(L) 


X(L) = TH*RR 
DO 399 I=1,M1 
IF (I.EQ.L) GO TO 39¢ 


MQ = MF +1 
G = -D(1)*RR 
E(MQ) = G 


X(I) = X(1L) + G*TH 
390 CONTINUE 
IF (LG.EQ.@) GO TO 46 
IF (IH.GT.1) BACKSPACE 3 
WRITE (3) E 


C MEMORIZE THE INDEX OF THE VECTOR INTRODUCED INTO THE BASIS 


49@ IBV(L) = K 


GO TO 4¢ 


99999 FORMAT (//////35H | AUTOMATIC REVISED SIMPLEX METHOD/// 


* 17H OPTIMAL SOLUTION//33H MINIMAL SCHEDULE LENGTH ‘TMIN =, 
* F12.5///) 


99998 FORMAT (/////37H NUMBER OF ITERATIONS GREATER THAN NI///) 
99997 FORMAT (3@X, 1H*, 17X, 1814) 

99996 FORMAT (30X, 2H* , 12, 2114) 

99995 FORMAT (1H+, 31X, 414) 

99994 FORMAT (30X, 2H* , 2214) 

99993 FORMAT (3@X, 2H* , 12, 2114) 

99992 FORMAT (30X, 2H* , 514, 1X, 1714) 

99991 FORMAT (3@X, 2H* , 12, 514, 1X, 1614) 

9999@ FORMAT (3@X, 3H* , 2214) 

99989 FORMAT (3@X, 1H*, 2214) 

99988 FORMAT (3@X, 1H*/1X, 12@(1H-)/3@X, 1H*) 

99987 FORMAT (3@X, 1H*/1X, 120(1H-)//) 

99986 FORMAT (1X, 120(1H-)/3@X, 1H*/30X, 1H*, 40X, I@HACTIVITIES/ 


185¢ 
1869 
1870 
1880 
189¢ 
1906 
191¢ 
192¢ 
1930 
194¢ 
1950 
1960 
197¢ 
198@ 
1990 
2000 
2016 
2020 
2030 
2049 
2050 
2060 
2076 
2080 
2090 
2100 
211¢ 
212¢ 
2130 
2140 
215@ 
2160 
217@ 
2180 
2190 
2200 
2216 
2226 
2230 
2246 
2250 
226¢ 
2276 
2286 
2296 
2300 
2310 
2320 
2330 
2340 
235@ 
2369 
2370 
2386 
2390 
2400 
2410 
2420 
2430 
2440 
2450 
2460 
2470 
2480 
2490 
2500 
251¢ 
2520 
2530 
2540 
2550 
2560 
2570 
2580 
2590 
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COLLECTED ALGORITHMS (cont.) 


* 30K, 1H*/13X, 4HTIME, 13X, 2H* , 89(1H-)/11X, QHINTERVALS, 
* 10X, 1H*) 
END 


SUBROUTINE GEN(PROC, PRE, PRI, M, Ml, M2, ND, K, KW, RT, RT1, 


* IP, NS, IBV, LO, U, D, R, RL) 

C PURPOSE 

C SUBROUTINE GEN GENERATES ALL RESOURCE FEASIBLE SETS. 

C DESCRIPTION OF PARAMETERS 

C PROC LOGICAL VARIABLE. IF PROC IS .TRUE. RESOURCE CONSTRAINTS ARE 
C NOT CHECKED, AND SETS WITH THE NUMBER OF ELEMENTS LESS THAN OR 
C EQUAL TO IP ARE GENERATED. IP IS DETERMINED IN SUBROUT. ARSME 
C PRE LOGICAL VARIABLE. PRE IS .TRUE. IN THE FIRST ITERATION 

C PRI LOGICAL VARIABLE. IF PRI IS .TRUE. SUBROUTINE GEN CALLS 

C SUBROUTINE PRISET TO PRINT RESULTS OF ARSME 

C DA LOGICAL VARIABLE. DA IS .TRUE. IF THE MAIN SET IS RESOURCE 

C FEASIBLE 

C KAS VECTOR CONTAINING THE NUMBERS OF ACTIVITIES IN THE MAIN SET 

Cc CURRENTLY BEING CONSIDERED. 

C KAR VECTOR OF THOSE INDICES OF KAS ELEMENTS WHICH COMPOSE THE 

C SUBSET CURRENTLY BEING CONSIDERED. 

C IC NUMBER OF ELEMENTS OF THE MAIN SET CURRENTLY BEING CONSIDERED 
C NR NUMBER OF ELEMENTS OF THE SUBSET CURRENTLY BEING CONSIDERED 

C LI SET COUNTER 


INTEGER RT, RT1 
LOGICAL PRE, PRI, DA, PROC 
DIMENSION NS(M2), IBV(M1), LO(M), U(M1), D(M1), R(M,RT), 
* RL(RT), KAS(100), KAR(100), KA(10@), RC(1060) 
Js =1 
LI = 1 
DO 30% KG=1,ND 
C GENERATE A MAIN SET 
Ic = @ 
DO 1@ ID=1,M2,2 
IF (NS(ID).GE.KG) GO TO 2¢ 
IF (NS(ID+1).LE.KG) GO TO 10 


Ic = Ic + 1 
KAS(IC) = (ID+1)/2 
KAR(IC) = IC 


1@ CONTINUE 
C NOTE-- DO LOOP IS NEVER EXITED HERE. 
20 II =I1¢ 
J = ID 
DO 3@ ID=J,M2,2 
IF (NS(ID) .NE.KG) GO TO 4@ 


Ic = I1¢ + 1 
KAS(IC) = (ID+1)/2 
KAR(IC) = IC 


30 CONTINUE 
40 IF (PROC) GO TO 12@ 
C CHECK THE RESOURCE FEASIBILITY OF THE MAIN SET 
NP 


5 
MQ = KAS(1) 
H = R(MQ,J) 
G=GtH 
RC(I) = H 
50 CONTINUE 
IF (G.LE.RL(J)) GO TO 9@ 
DA = .FALSE. 
C ORDER ACTIVITIES IN THE MAIN SET 
IF (II.GT.1) CALL ORDSNE(.FALSE., II, KAS, RC) 
IF ((IC-II).GT.1) CALL ORDSNE(.FALSE., IC-II, KAS(II+1), 
x RC(II+1)) 
G= @¢. 
DO 6@ I=1,IC 
G = G + RC(1) 
IF (G.GT.RL(J)) GO TO 70 


60 CONTINUE 
C NOTE-- DO LOOP IS NEVER EXITED HERE. 
70 IF (NP.LE.I) GO TO 99% 
NP = I 


ARS 
ARS 
ARS 


GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
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COLLECTED ALGORITHMS (cont.) 


IF (RT1.EQ.1) GO TO 9¢ 
DO 8@ I=1,IC 
KA(I) = KAS(TI) 
80 CONTINUE 
96 CONTINUE 
IF (DA) GO TO 120 
IF (RT1.EQ.1) GO TO 110 
DO 19@ I=1,IC 
KAS(L) = KA(I) 
100 CONTINUE 


C GENERATE SUBSETS 


Cc 


1106 NR = IC 
LF (NP.LE.(II+1)) GO TO 25@ 
120 WNR=II 
130 NR = NR+1 
140 IF (PROC) GO TO 270 
IF (DA) GO TO 18¢@ 
CHECK RESOURCE FEASIBILITY OF THE SUBSET 
NP = 99999 
DO 17@ J=1,RT1 
G= @. 
DO 15@ I=1,NR 
MQ = KAR(I) 
MQ = KAS (MQ) 
G = G + R(MQ,J) 
IF (G.GT.RL(J)) GO TO 160 


15 CONTINUE 
GO TO 17@ 
16¢ IF (NP.GT.I) NP = I 


170 CONTINUE 
IF (NR.GE.NP) GO TO 256 
GO TO SIMPLEX PROCEDURE 
186 IF (PRI) GO TO 26¢ 
CALL KFIND(PRE, Ml, NR, K, LI, KAS, KAR, IBV, U, D) 
INCREASE THE NUMBER OF SETS IN THE SET COUNTER 
196 LI =LI+1 
IF (KAR(NR).LT.IC) GO TO 13@¢ 
GENERATE THE PRIMARY SUBSET 
2066 NR = NR - 1 
IF (NR.EQ.6) GO TO 306¢ 
210 KAR(NR) = KAR(NR) + 1 
IF (KAR(NR) .EQ.IC) GO TO 14¢ 
MQ = NR +1 
MP = NR + IC — KAR(NR) 
IF (PROC) GO TO 29¢ 
220 DO 23@ I=MQ,MP 
KAR(I) = KAR(I-1) + 1 
236 CONTINUE 
246 IF (KAR(NR).LE.II) NR = II - KAR(NR) + NR +1 
GO TO 14¢ 
GENERATE THE NEW PRIMARY SUBSET BECAUSE OF RESOURCE INFEASIBILITY 
OF THE LAST-GENERATED SET 
25@ IF (KAR(NP).EQ.IC) GO TO 26¢ 
NR = NP 
GO TO 210 
CHECK IF THE SET COMPRISE THE OPTIMAL SOLUTION 
260 IF (LI.NE.IBV(JS)) GO TO 19¢ 
CALL PRISET(M, NR, KW, JS, K, KAR, KAS, LO, D) 
JS = JS +1 
IF (JS.EQ.M1) RETURN 
GO TO 19¢ 
GENERATE THE SETS IN THE CASE OF EQUAL RESOURCE REQUIREMENTS 
270 IF (NR.LE.IP) GO TO 18¢ 


NR = IP 
IF (KAR(NR).LE.II) GO TO 28 
GO TO 210 
280 KAR(NR) = II + 1 
GO TO 18¢@ 


296 IF (MP.GT.IP) MP = IP 
IF (MP.LT.MQ) GO TO 246 
GO TO 22¢ 
306 CONTINUE 
RETURN 
END 


GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
GEN 
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GEN 
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GEN 
GEN 
GEN 
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GEN 
GEN 


520-P10- 


0 


COLLECTED ALGORITHMS (cont.) 520-P11- 0 


SUBROUTINE KFIND(PRE, Ml, NR, K, LI, KAS, KAR, IBV, U, D) KFI 1 

C PURPOSE KFI 260 
C SUBROUTINE KFIND CHECKS TO DETERMINE IF THE INTRODUCTION OF THE KFI 39 
C CURRENTLY CONSIDERED SET ( VECTOR ) INTO THE BASIS IS MORE KFI 46 
C PROFITABLE THAN THE INTRODUCTION OF THE PREVIOUSLY GENERATED SETS. KFI 5@ 
LOGICAL PRE KFI 6@ 
DIMENSION U(M1), D(M1), IBV(M1), KAS(106), KAR(16@) KFL 79 

IF (.NOT.(PRE .AND. (NR.EQ.1))) GO TO 1¢ KFI 8@ 

C CALCULATE THE INITIAL VALUES OF VECTOR IBV KFI 9¢ 
MQ = KAR(1) KFI 16¢ 

MQ = KAS (MQ) KFI 11¢ 
IBV(MQ) = LI KFI 120 

C CALCULATE VALUE G OF THE CRITERION FOR INTRODUCING A VECTOR INTO KFI 13@ 
C THE BASIS KFI 140 
1d@Gc=@. KFI 15¢ 

DO 2@ I=1,NR KFI 16¢ 

MQ = KAR(T) KFI 179 

MQ = KAS (MQ) KFI 18¢ 

G = G + U(MQ) KFI 19¢ 

20 CONTINUE KFI 200 

RR = 1 — NR KFI 21¢@ 

G = G + U(M1)*RR KFI 22¢ 

IF (D(M1).LE.G) RETURN KFI 230 

C MEMORIZE THE VECTOR FOR WHICH G IS AT MINIMUM KFI 240 
D(M1) =G KFI 25¢@ 

K = LI KFI 260 

MQ =Mi-1 KFI 270 

DO 30 I=1,MQ KFI 280 

D(I) = @. KFI 290 

30 CONTINUE KFI 36¢ 

DO 4@ I=1,NR KFI 31¢ 

MQ = KAR(I) KFI 320 

MQ = KAS (MQ) KFI 330 

D(MQ) = 1. KFI 34¢ 

4@ CONTINUE KFI 350 
RETURN KFI 36¢@ 

END KFI 37 
SUBROUTINE PRISET(M, NR, J, JS, K, KAR, KAS, LO, X) PRI 1 

C PURPOSE PRI 2 
C SUBROUTINE PRISET PRINTS THE SET OF ACTIVITIES COMPOSING THE PRI 390 
C OPTIMAL SOLUTION AND THE TIME-INTERVALS OF ITS PERFORMANCE. PRI 4@ 
DIMENSION KAR(1@6), KAS(1@0), LO(M), X(M) PRI 50 

DO 1@ I=1,M PRI 60 

LO(I) = @ PRI 7 

16 CONTINUE PRI 8@ 

DO 2¢ I=1,NR PRI 9¢ 

MQ = KAR(I) PRI 100 

MQ = KAS(MQ) PRI 11 

MP = J*44 PRI 120 

MR = MP — 44 PRI 130 

IF (MQ.LE.MR .OR. MQ.GT.MP) GO TO 20 PRI 14@ 

LO(MQ) = 1 PRI 15@ 

26 CONTINUE PRI 160 
C= @. PRI 170 

IF (JS.EQ.1) WRITE (2,99999) C, X(JS), (LO(I),I=1,K) PRI 180 

MQ = JS - 1 PRI 190 

IF (JS.NE.1) WRITE (2,99999) X(MQ), X(JS), (LO(I),I=1,K) PRI 200 
RETURN PRI 21 

99999 FORMAT (1X, F12.5, 3H -, F12.5, 4H * , 4412) PRI 220 
END PRI 230 
SUBROUTINE ORDSNE(PRI, IC, KAS, RC) ORD 19 


C PURPOSE ORD 20 
Cc IF PRI IS .TRUE. SUBROUTINE ORDSNE ORDERS ELEMENTS OF VECTOR KAS ORD 30 
C IN INCREASING ORDER OF THEIR VALUES AND VECTOR RC CORRESPONDINGLY. ORD 40 
C IF PRI IS .FALSE. SUBROUTINE ORDSNE ORDERS ELEMENTS OF VECTOR RC ORD 50 
C IN DECREASING ORDER OF THEIR VALUES AND VECTOR KAS CORRESPONDINGLY. ORD 60 


LOGICAL PRI ORD 70 
DIMENSION RC(IC), KAS(IC) ORD 80 
ID = -IC/2 ORD 90 
1@ IF (ID.GE.@) RETURN ORD 1040 


MQ = ID + IC ORD 110 


COLLECTED ALGORITHMS (cont.) 


20 


36 


DO 49 J=1,MQ 


I=J 
IF (I.LT.1) GO TO 4¢ 
JJ = I - ID 


IF (PRI) GO TO 50 

IF (RC(I).GE.RC(JJ)) GO TO 4@ 
G = RC(1) 

RC(L) = RC(JJ) 

RC(JJ) =G 

II = KAS(I) 

KAS(I) = KAS(JJ) 

KAS(JJ) = II 

I=1I+ ID 

GO TO 2¢ 


46 CONTINUE 


= ID/2 


GO TO 1@ 


50 IF (KAS(I).LE.KAS(JJ)) GO TO 4@ 


GO TO 3¢ 
END 


120 
13¢ 
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150 
16@ 
176 
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COLLECTED ALGORITHMS FROM ACM 


ALGORITHM 521 
Repeated Integrals of the Coerror Function | S15 | 


WALTER GAUTSCHI 
Purdue University 


Key Words and Phrases: repeated integrals of the coerror function, Taylor's series, 
three-term recurrence relation, Miller's backward recurrence algorithm 

CR Categories: 5.12 

Language: Fortran 


DESCRIPTION 


This algorithm implements the procedures developed in [1]. 
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ALGORITHM 


SUBROUTINE INERFC(X, NMAX, ACC, FZERO, F, IFLAG) INE 1¢ 
THIS PROGRAM GENERATES FN(X) FOR N=1,2,...,NMAX, WHERE INE 20 
FN(X)=EXP (X**2)*INERFC(X), IF X.GE.6., AND FN(X)=INERFC(X), IF INE  3¢ 
X.LT.@., INERFC(X) BEING THE N-TH REPEATED INTEGRAL OF THE COERROR INE 4¢ 
FUNCTION ERFC(X), EXTENDED FROM X TO INFINITY. THE PROGRAM ALSO INE 5@ 
SUPPLIES EXP (X**2)*ERFC(X),IF X.GE.6., AND ERFC(X), IF X.LT.@.. INE 6¢ 
THE USER HAS TO SPECIFY THE DESIRED ACCURACY, AS WELL AS THE PRECISIONINE 7¢ 
OF THE HIGHEST PRECISION MODE HE 1S PREPARED TO USE. THE FORMER IS INE 8 
INPUT VIA THE PARAMETER ACC IN THE CALL LIST, WHICH DESIGNATES THE INE 9@ 
NUMBER OF CORRECT SIGNIFICANT DECIMAL DIGITS DESIRED IN THE RESULTS. INE 1¢¢ 
THE LATTER IS INPUT VIA THE PARAMETER PREC IN THE DATA STATEMENT. THE INE 11 
VALUE OF PREC SHOULD BE SET APPROXIMATELY EQUAL TO BETA*ALOG(2.)/ INE 12¢ 
ALOG(1@.), WEERE BETA IS THE NUMBER OF BINARY DIGITS AVAILABLE IN THE INE 13¢ 
MANTISSA OF THE HIGHEST PRECISION FLOATING-POINT WORD. ORDINARILY, THEINE 14@ 
HIGHEST PRECISION IS DOUBLE PRECISION, EITHER HARDWARE GENERATED OR INE 15@ 
SOFTWARE GENERATED, BUT IT MAY ALSO BE SINGLE PRECISION. IN ANY CASE, INE 16@ 
ACC HAS TO BE LESS THAN PREC, THE DIFFERENCE BEING AT LEAST EQUAL TO INE 176 
ONE, PREFERABLY SEVERAL UNITS LARGER. EVIDENTLY, ACC SHOULD NOT BE INE 18 
SPECIFIED TO EXCEED THE PRECISION OF THE LOWEST PRECISION MODE USED. INE 19¢ 

THE DATA STATEMENT CONTAINS ANOTHER MACHINE-DEPENDENT PARAMETER, INE 200 
BOTEXP, WHICH IS, APPROXIMATELY, THE SMALLEST NEGATIVE NUMBER SUCH INE 21@ 
THAT 10.**BOTEXP IS STILL REPRESENTABLE ON THE COMPUTER IN SINGLE PRE-INE 226 
CISION FLOATING-POINT ARITHMETIC, THE TYPE OF BOTEXP IS REAL. IN THE INE 23¢ 
DATA STATEMENT BELOW THE PARAMETERS PREC AND BOTEXP ARE SET TO CORRE- INE 24¢ 


ANQAADQAAAAANQADAAAANAANNAQAARAANDAARAANAANAANAO4 


SPOND TO THE MACHINE CHARACTERISTICS OF THE CDC 6560 COMPUTER. INE 250 
PARAMETER LIST INE 26¢ 
X - - THE ARCUMENT OF INERFC. TYPE REAL. INE 276 

NMAX - - THE UPPER LIMIT ON N. TYPE INTEGER. INE 2806 
ACC - — THE NUMBER OF CORRECT SIGNIFICANT DECIMAL DIGITS DESIRED INE 29¢ 

IN THE RESULTS. TYPE REAL. INE 300 
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C 


AN NDANNANKQANANAANAADADNDNANANQNNDADANDNDANANAAADAANANAANAAAAAARANAANANRAANAAAARAANAAANAAAANA 


FZERO - - AN OUTPUT VARIABLE RETURNING EXP (X**2)*ERFC(X), IF 
X.GE.@., AND ERFC(X), IF X.LT.@. TYPE REAL. 

THE NAME OF A ONE-DIMENSIONAL ARRAY HOLDING THE RESULTS 
FN(X), N=1,2,...,NMAX. THE ARRAY HAS DIMENSION NMAX. 

AN ERROR FLAG INDICATING A NUMBER OF FATAL ERROR CON- 
DITIONS UPON EXECUTION. TYPE INTEGER. THE VALUES OF THIS 
VARIABLE HAVE THE FOLLOWING MEANINGS. 


IFLAG - - 


THE SUBROUTINE BELOW IS WRITTEN WITH THE ASSUMPTION THAT PART OF 
THE COMPUTATION IS DONE IN DOUBLE PRECISION AND THE REST IN SINGLE 
PRECISION. TO OBTAIN A VERSION OF THIS SUBROUTINE, THAT OPERATES 
ENTIRELY IN SINGLE PRECISION, THE FOLLOWING CHANGES MUST BE MADE. 

(1) DELETE THE DOUBLE PRECISION TYPE DECLARATION. 

(2) REPLACE THE SECTION OF PROGRAM FROM STATEMENT LABELED 3¢ 
(INCLUSIVE) TO STATEMENT LABELED 6@ (INCLUSIVE) BY THE FOLLOWING 
; PIECE OF PROGRAM. 


30 


46 


THE ARRAYS R@ AND R1 IN THE DIMENSION STATEMENT ARE LOCAL TO THE 


IFLAG=$ - NO ERROR CONDITION. 


IFLAG=1 - ILLEGAL NEGATIVE OR ZERO VALUE OF NMAX. 


INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 


IFLAG=2 - EXCESSIVELY LARGE VALUE OF NMAX. REDIMENSION THEINE 
ARRAYS R@ AND R1 TO HAVE DIMENSION .GE. NMAX, IFINE 


INDEED NMAX MUST BE THAT LARGE. 

IFLAG=3 - INAPPROPRIATE ACCURACY SPECIFICATION. 

IFLAG=4 -— UNUSUAL UNDERFLOW OF EXP (-X**2). TRY REDUCING 
THE ERROR TOLERANCE PREC-ACC, EITHER BY DE- 
CREASING PREC OR BY INCREASING ACC. 

IFLAG=5 - TAYLOR SERIES FOR ERFC(X) DOES NOT CONVERGE 
WITHIN 2¢@ TERMS FOR SOME UNKNOWN REASON. 


INE 
INE 
INE 
INE 
INE 
INE 
INE 


IFLAG=6 - NU IN THE BACKWARD RECURRENCE ALGORITHM EXCEEDS INE 


59006, PROBABLY BECAUSE X IS A SMALL POSITIVE 
NUMBER, NMAX RELATIVELY LARGE, AND THE ERROR 


INE 
INE 


TOLERANCE SMALL. TRY INCREASING THE ERROR TOLER-INE 
ANCE PREC-ACC, EITHER BY INCREASING PREC OR BY INE 


DECREASING ACC. 


DEPS=.5*1@.**(-PREC) 
TE=C*X 

SUM=1.-TE 

N= 

Nl=1 

N=N+1 

N1=N1+2 

IF(N.GT.2@6) GOTO 27¢ 
TE=-TE*XSQ/FLOAT (N) 
TERM=TE/FLOAT (N1) 
SUM=SUM~TERM 


IF (ABS (TERM) .GT .DEPS*ABS(SUM)) GOTO 4@ 


F1l=T*SUM 


INE 
INE 
INE 
INE 
INE 


INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 
INE 


SUBROUTINE. THEY BOTH NEED TO HAVE DIMENSION LARGER OR EQUAL TO NMAX,. INE 


WE DECLARED THEIR DIMENSION TO BE 5@@, ASSUMING THAT NMAX WILL NOT 


INE 


EXCEED 50@. IN THE EVENT IT DOES, THE SUBROUTINE EXITS WITH THE ERROR INE 
FLAG AT 2, IF THE USER EXPECTS HIS VALUES OF NMAX TO BE CONSISTENTLY INE 
MUCH LESS TKAN 5@0, HE CAN SAVE STORAGE BY LOWERING THE DIMENSION OF INE 
R@ AND R1 AND AT THE SAME TIME ADJUSTING THE ERROR EXIT STATEMENT (THEINE 


THIRD EXECUTABLE STATEMENT IN THE PROGRAM). 

WITH THE EXCEPTION NOTED UNDER IFLAG=4, ANY VARIABLE THAT UNDER- 
FLOWS MAY BE SET EQUAL TO ZERO. NO PRECAUTION IS TAKEN AGAINST OVER- 
FLOW, WHICH MAY OCCUR IN THE DO-LOOP AFTER STATEMENT 706 IF X.LT.@. 


AND ABS(X) AND/OR NMAX IS LARGE. 


REFERENCE - W. GAUTSCHI, EVALUATION OF THE REPEATED INTEGRALS OF 
THE COERROR FUNCTION, ACM TRANS. MATH. SOFTWARE. 


DIMENSION F(NMAX), R@(50¢), R1(500) 


DOUBLE PRECISION DEPS, DC, DX, DXSQ, DFM1, DF@, DF1, DN, DNI, 


* DTE, DTERM, DSUM 


LOGICAL 


DATA FRSTIM, PREC, BOTEXP /.TRUE.,28.8989,-293./ 


IFLAG = 


FRSTITM 


i) 


IF (NMAX.LT.1) GO TO 23@ 
IF (NMAX.GT.5@¢) GO TO 244 
TOL = PREC — ACC 


IF (TOL.LT.1.) GO TO 25¢ 
I=1 

EPS = .5*1@.%** (-ACC) 

XSQ = X*X 


IF (.NOT.FRSTTM) GO TO 1¢ 

P = ATAN(1.) 

ALI@ = ALOG(1@.) 

C = SORT(1./P) 

DC = DSQRT(1.D@/DATAN(1.D@)) 


INE 
INE 
INE 
INE 
INE 
INE 
INE 
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FRSTTM = .FALSE. 
1d S = 9. 
IF (-XSQ.GT.ALI@*BOTEXP) S = EXP(-XSQ) 
B = .S*ALIO*TOL + .25*ALOG(2.*P) 
Bl = .5*AL1@¢*(TOL-1.) 
IF (XSQ.GT.B) GO TO 9¢ 
IF (X.LT.@.) GO TO 2¢ 
FO = C 
IF (S.EQ.@.) GO TO 266 
T= 1./s 
SQ = SQRT(2.*FLOAT (NMAX) ) 
IF ((X.GE.1.12 .AND. XSQ+tSQ*X.GT.B) .OR. (X.LT.1.12 .AND. 
* SQ*X.GT.B1)) GO TO 16¢ 
GO TO 3¢ 
2¢ FO = C*S 
Tel, 
C 
C EVALUATION OF ERFC(X) BY TAYLOR SERIES IN DOUBLE PRECISION 
Cc 
30 DEPS = .5D@*1¢.D@** (-PREC) 
DX = DBLE(X) 
DXSQ = DX*DX 
DTE = DC*DX 
DSUM = 1.D@ - DTE 
DN = $.D¢ 
DN1 = 1.D@ 
46 DN = DN + 1.D@ 
DN1 = DN1 + 2.D¢@ 
IF (DN.GT.2.D2) GO TO 27¢ 
DIE = —DTE*DXSQ/DN 
DTERM = DTE/DNI1 
DSUM = DSUM - DTERM 
IF (DABS (DTERM) .GT.DEPS*DABS(DSUM)) GO TO 4@ 
IF (X.LT.@.) GO TO 6¢ 


EVALUATION OF EXP (X**2)*INERFC (X) ,X.GE.@.,BY FORWARD RECURSION IN 
DOUBLE PRECISION 


aaaAo 


Cc 
EXP (DXSQ) *DSUM 
SNGL(DF1) 


ogo 


(-DX*DFG+ . 5D@*DFM1) /DBLE (FLOAT (N) ) 
F(N) = SNGL(DF1) 
5@ CONTINUE 


RETURN 
C 
C EVALUATION OF INERFC(X),X.LT.@.,BY FORWARD RECURSION 
C 


6¢ Fl = SNGL(DSUM) 
7@ FZERO = Fl 
DO 8@ N=1,NMAX 
FM1 = F@ 
FO = Fl 
Fl = (-X*FG+.5*FM1) /FLOAT(N) 
F(N) = Fl 
8@ CONTINUE 
RETURN 
9@ IF (X.LT.@.) GO TO 11¢ 
16¢ NO = NMAX 


X@ = X 
GO TO 13¢ 
11@ IF (XSQ.LT.(ACC+1.)*ALI1@-.572) GO TO 12¢ 
FQ@ = C*S 
Fl = 2 
GO TO 7¢ 
126 I = 2 
NO = 1 
X@ = -X 


BACKWARD RECURRENCE ALGORITHM FOR EVALUATING FN(ABS(X)) FOR N=1,2, 
.+.,N@, WHERE N@=NMAX IF X.GT.@. AND N@=1 IF X.LT.Q. 


aaAaaAN 


136 DO 14¢ N=1,N@ 
R1(W) = @. 


1680 
1690 
1166 


2 1110 


112@ 
1130 
114¢ 
115@ 
116¢ 
117¢ 
118¢ 
119¢ 
1200 
121¢ 
1226 
123¢ 
1246 
1250 
126¢ 
1276 
1280 
129¢ 
136¢ 
1310 
1320 
133¢ 


, 1346 


135¢ 
136¢ 
1370 
138¢ 
1396 
1400 
141¢ 
1420 
1430 
1446 
1450 
1466 
147@ 
1489 
149¢ 
1509 
151¢ 
1526 
1530 
1540 
155@ 
156@ 
157¢ 
158@ 
159¢ 
1600 
1610 
1620 
1630 
164¢ 
165¢ 
1660 
1670 
1680 
169¢ 
1700 
171¢ 
172@ 
1730 
174¢ 


; 175¢ 


176@ 
177¢ 
178¢ 
179¢ 
1806¢ 
181¢ 
182¢ 
1830 
184@ 
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aaa 


14@ CONTINUE 
FN@ = FLOAT (NQ) 
NU 
15¢@ NU = NU + 1¢ 
IF (NU.GT.59060) GO TO 28¢ 
NOP1 = NO + 1 
NUM = NU - N@P1 
DO 16¢ N=1,NO@ 
RO(N) = RIN) 
16@ CONTINUE 
R=@. 
DO 170 K=1,NUM 
N=NU-K 
R = .5/(X@+FLOAT (N+1)*R) 
17@ CONTINUE 
DO 18% K=1,N@ 


N = N@P1 -K 
R = .5/(XO+FLOAT (N+1)*R) 
RI(N) = R 


1846 CONTINUE 
DO 194 N=1,N@ 


IF (ABS(R1(N)-RO(N)) .GT.EPS*ABS(R1(N))) GO TO 15¢ 


194 CONTINUE 
FO = .5*C/(X@+R1(1)) 
FZERO = FO 
FF = F@ 
DO 2¢¢ N=1,N@ 
FF = R1(N)*FF 
F(N) = FF 
2¢@ CONTINUE 
GO TO (21¢, 226), I 
21@ RETURN 


STARTING VALUE FOR INERFC(X),X.LT.@.,PRIOR TO FORWARD RECURSION 


220 Fl 2. — S*FO 
F@ = CS 
GO TO 7¢ 
23@ IFLAG = 
RETURN 
246 IFLAG = 
RETURN 
250 IFLAG = 
RETURN 
26@ IFLAG = 
RETURN 
270 IFLAG = 
RETURN 
286 IFLAG = 
RETURN 
END 


uw ~~ WwW be a 


[on 


IFIX( (SQRT (FN@)+(2.3026*ACC+1 . 3863) /(2.8284*X@) )**2-5.) 


185¢ 
186¢ 
1870 
188¢ 
189¢ 
19¢¢ 
1910 
192¢ 
193¢ 
1946 
1950 
196¢ 
1979 
198¢ 
199@ 
2000 
2010 
2020 
2630 
204¢ 
2050 
2060 
2670 
208¢ 
2090 
216¢ 
211¢ 
212¢ 
2130 
214¢ 
2150 
216¢ 
217¢ 
2186 
219¢ 
2200 
2210 
2226 
2230 
2240 
2250 
226@ 


; 2270 


2280 
2290 
2300 


, 2310 


232¢ 
233¢ 
234¢ 
2350 
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ALGORITHM 522 


ESOLVE, Congruence Techniques for the Exact 


Solution of Integer Systems of Linear 
Equations | F4| 


S. CABAY and T. P. L. LAM 
University of Alberta 


Key Words and Phrases: symbolic and algebraic manipulation, systems of linear equa- 


tions, congruence techniques, modular methods, Chinese remainder theorem 


CR Categories: 5.14 
Language: Fortran 


DESCRIPTION 


Descriptions of the main algorithm, ESOLVE, and accompanying subroutines 
SUBBND, MRADIX, and FRADIX, together with experimental results, are given 


in [1]. 


REFERENCES 


~ 1. Casay,S., anp Lam, T.P.L. Congruence techniques for the exact solution of integer systems 


of linear equations. ACM Trans. Math. Software 3,4 (Dec. 1977), 386-497. 


ALGORITHM 
c 
CRAERRARREKAARERKRAERERRERERERERRERERRR RR RRRERRER RRR ER ERE RRR 
Cc k 
C TWO TEST EXAMPLES * 
CC a a a a ee se * 
Cc * 
CRHERKKKRRKAREKRERRKEERRRERERERERERERRRRRRRRERRRERERRRERRRRRRRRRARKE 
c 

INTEGER P(160) ,AMOD (26,21) ,Y(32,2@,1) ,DET(32) ,T,TWOT1, 

1 SUM(7) ,GAMMA (7) ,DELTA(7) ,A(10) ,C(10) ,B 

INTEGER A1(1,5,5),B1(1,5,1),A2(3,20, 26) ,B2(3,20,1),TEMP1,Q 

REAL S$(21) 

COMMON /PRIMEB/ P, IPRIME(1¢@) 

B = 160600 
Cc 
CHERKEAKERKRAKEAEERERRREREREERERERRRRRERERERRRRRRRRRRRRRRRRRRRER 
C * 
Cc EXAMPLE 1 — PASCAL MATRIX. * 
C * 
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MAIN@12¢ 
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MAIN@17¢ 
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COLLECTED ALGORITHMS (cont.) 
C A1*X = Bl. * MAING2060 
Cc * MAIN@21¢ 
C Tm] * MAIN@220 
C N=5 * MAING23@ 
Cc M=1 * MAIN@24¢ 
Cc * MAIN@25@ 
CEKKKRRKERAREKEREKEKE RERKEKREKRERRKKRRRREERERERERRERERE RE REKKKKKRKKEK MAIN@26@ 
Cc MAIN@27¢ 
T=1 MAIN@280 
N=5 MAING29@ 
M=1 MAING300 
NM = N+M MAIN@31¢ 
Cc MAING32@ 
Cc **GENERATE THE MATRICES Al AND Bl. MAING33@ 
Cc MAING34@ 
DO 1 I=1,N MAIN@35@ 
Al(1,I,1) = 1 MAING36¢ 
1 Al(1,1,I) = 1 MAINO37@ 
C OD MAING38¢ 
DO 2 I=2,N MAIN@39¢ 
DO 2 J=2,N MAIN@400 
2 Al(1,I,J) = A1(1,1,J-1)+Al(1,I-1,J) MAIN@41¢6 
Cc OD MAING@42¢ 
Cc OD MAIN@43¢ 
Bl(1,1,1) = 1 MAING44@ 
DO 3 I=2,N MAIN@45@ 
3 BL(1,1,1) = B1(1,I-1,1)+A1(1,1,N) MAING46@ 
C oD MAING47@ 
Cc MAIN@480 
Cc **PRINT Al AND Bl IN FIXED-RADIX FORM. MAING49@ 
Se MAIN@560 
WRITE (6,42) MAIN@51¢ 
DO 5 K=1,T MAING@5 26 
WRITE(6,46) K MAIN@530 
DO 4 I=1,N MAIN@54@ 
4 WRITE(6,43) (A1(K,1I,J),J=1,N) MAIN@55@ 
C oD MAING56@ 
5 CONTINUEMAIN@57@ 
Cc OD MAING58¢ 
WRITE (6,44) MAING59@ 
DO 7 K=1,T MAING600 
WRITE(6,49) K MAIN@61@ 
DO 6 I=1,N MAING620 
6 WRITE(6,43) (B1(K,I,J),J=1,M) MAIN@63¢ 
Cc OD MAING64¢ 
7 CONTINUEMAIN@65@ 
Cc e))) MAING66@ 
Cc MAING@670 
C **CONVERT Al AND Bl FROM FIXED-RADIX TO MIXED-RADIX FORM. MAIN@68¢ 
C MAIN@69¢ 
Nl = 1 MAINGO76@ 
TEMP = (FLOAT(N1)*ALOG(FLOAT(B)) + ALOG(2.@)) /ALOG(FLOAT(P(1))) MAIN@71¢ 
LMAX = TEMP MAIN@720 
IF (TEMP-FLOAT(LMAX) .GT.@.@1) LMAX = LMAX+1 MAING73¢@ 
DO 1@ I=1,N MAIN@74@ 
DO 1¢ J=1,N MAINO75@ 
DO 8 K=1,N1 MAING76¢@ 
8 A(K) = A1(K,I,J) MAINO77@ 
C OD MAING78@ 
CALL MRADIX(A,N1,C,LMAX,L,B, IER) MAINO79@ 
DO 9 K=1,L MAING8O0 
9 A1(K,1I,J) = C(K) MAIN@81¢ 
Cc 0))) MAIN@82¢ 
Cc (0))) MAING83@ 
C OD MAING840 
1¢ CONTINUEMAIN@85@ 
DO 13 I=1,N MAIN@86¢ 
DO 13 J=1,M MAING87@ 
DO 11 K=1,N1 MAING88¢ 
11 A(K) = B1(K,I,J) MAIN@890 
Cc oD MAINGIGO 
CALL MRADIX(A,N1,C,LMAX,L,B, IER) MAING916 
DO 12 K=1,L MAING92¢ 
12 B1(K,1,J) = C(K) MAING930 
Cc OD MAING94G 
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aaaAa 


aan 


14 


15 


OD 
OD 


**PRINT Al AND Bl IN MIXED-RADIX FORM. 


WRITE (6,45) 
DO 15 K=1,T 
WRITE(6,46) K 
DO 14 I=1,N 
WRITE(6,47) (A1(K,1I,J),J=1,N) 
oD 


OD 
WRITE (6, 48) 
DO 17 K=1,T 
WRITE (6,49) K 
DO 16 I=1,N 
WRITE(6,47) (B1(K,1,J),J=1,M) 
oD 


OD 
**COMPUTE MAXPRM. 


TWOTL = 2*T+1 


CALL SUBBND(A1,B1,GAMMA,DELTA,S,SUM,T,N,M,NM, 


TWOT 1, BOUND , MAXPRM) 
WRITE (6,5¢) BOUND,MAXPRM 


**SOLVE THE SYSTEM OF LINEAR EQUATIONS Al1*X=B1. 


CALL DRIVER (A1,B1,AMOD,T,N,M,NM,Y,DET,MAXPRM, B) 


C 
CHARARKERKRRKARKEERERKRERARERERERRRERERERERRRRRRERRRERERRRRRRERRRRER 


AANARNAANAAAARAANADNA 


aan 


18 


19 


20 


EXAMPLE 2 - PASCAL MATRIX. 


A2*X = B2. 
T=3 
N = 2¢ 
Mel 


T= 3 

N = 26 
M=1 

NM = NM 


**XGENERATE THE MATRICES A2 AND B2. 


DO 18 I=1,N 
A2(3,1,1) = 1 
A2(3,1,I1) = 1 

OD 

DO 19 K=1,2 
DO 19 I=1,N 

A2(K,I,1) = @ 
A2(K,1,1) = @ 
OD 

oD 

DO 21 I=2,N 
DO 21 J=2,N 

Q=¢ 

TEMF1 = @ 

DO 26 K=1,T 
Kl = T-K+l 


TEMP1 = A2(K1,1,J-1)+A2(K1,I-1,J)+Q 


Q = TEMP1/B 
A2(K1,1I,J) = TEMP] — Q*B 
oD 
oD 
oD 


Po 


REKREKERARERRERRRRRERRERERRRRERRRRRERRRARERERERRRRRRRRRRRRERERRRE 


MAING95@ 
MAING96@ 


CONTINUEMAIN@97@ 


MAING98¢ 
MAING9I9@ 
MAINIGOO 
MAIN1@1¢ 
MAIN162@ 
MAIN193@ 
MAINIO64@ 
MAINI@50 
MAINIG6¢ 


CONT INUEMAIN1907@ 


MAIN1@8@ 
MAIN169@ 
MAIN110¢ 
MAINI11@ 
MAIN112¢ 
MAIN1130@ 
MAIN114@ 


CONTINUEMAIN115@ 


MAIN116¢@ 
MAIN117@ 
MAIN118¢@ 
MAIN119¢ 
MAIN12¢6¢ 
MAIN121¢ 
MAIN122¢ 
MAIN123@ 
MAIN124@ 
MAIN125@ 
MAIN126@ 
MAIN127@ 
MAIN128@ 
MAIN129¢ 
MAIN136¢ 
MAIN131@ 
MAIN132@ 
MAIN133@ 
MAIN134@ 
MAIN135¢@ 
MAIN136@ 
MAIN137@ 
MAIN138@ 
MAIN139@ 
MAIN1406¢ 
MAINI141@ 
MAIN142@ 
MAIN143@ 
MAIN144@ 
MAIN145@ 
MAIN146@ 
MAIN147@ 
MAIN148¢ 
MAIN149¢ 
MAIN1L50¢ 
MAINI51@ 
MAIN152@ 
MAIN153@ 
MAINI54@ 
MAIN155@ 
MAIN156@ 
MAIN157@ 
MAIN158@ 
MAINI59@ 
MAIN1606¢ 
MAINI61@ 
MAIN162@ 
MAIN163¢ 
MAIN164@ 
MAIN165¢@ 
MAIN166@ 
MAIN167@ 
MAIN168@ 
MAIN169¢ 


522-P 3- 


0 


COLLECTED ALGORITHMS (cont.) 


21 


24 


25 


CONTINUEMAIN1 70 

B2(1,1,1) = @ MAIN171¢ 
B2(2,1,1) = @ MAIN172@ 
B2(3,1,1) = 1 MAIN173¢ 
DO 23 I=2,N MAIN174@ 
Q=¢ MAIN175@ 
TEMP1 = @ MAIN176@ 

DO 22 K=1,T MAIN177@ 

Kl = T-K+l MAIN178¢@ 

TEMP! = B2(K1,I-1,1)+A2(K1,1,N)+Q MAIN179@ 

Q = TEMP1/B MAIN186¢ 
B2(K1,1I,1) = TEMP1 - Q*B MAIN181¢ 

OD MAINI182¢ 

OD MAIN183¢ 
CONTINUEMAIN1840@ 

MAIN185@ 

*XPRINT A2 AND B2 IN FIXED-RADIX FORM. MAIN186¢ 
MAIN187@ 

WRITE (6, 42) MAIN188¢@ 
DO 25 K=1,T MAIN189¢ 
WRITE(6,46) K MAIN190¢ 

Kl = T-K+l MAIN191¢ 

DO 24 I=1,N MAIN192¢ 
WRITE(6,43) (A2(K1,1I,J) ,J=1,N) MAIN193@ 

OD MAIN194@ 

OD MAINI195@ 
CONTINUEMAIN1960@ 

WRITE (6, 44) MAIN197@ 
DO 27 K=1,T MAINI198@ 
WRITE(6,49) K MAIN199@ 

Kl = T-K+l MAIN2000 

DO 26 I=1,N MAIN2¢16 
WRITE(6,43) (B2(K1,1,J),J=1,M) MAIN202¢ 

oD MAIN203@ 

OD MAIN20640 
CONTINUEMAIN2@5@ 

MAIN206¢@ 

**CONVERT A2 AND B2 FROM FIXED-RADIX TO MIXED-RADIX FORM. MAIN2067@ 
MAIN2¢686 

Nl = 3 MAIN209@ 
TEMP = (FLOAT(N1)*ALOG(FLOAT(B)) + ALOG(2.@))/ALOG(FLOAT(P(1))) MAIN210@ 
LMAX = TEMP MAIN211¢ 
IF (TEMP-FLOAT(LMAX) .GT.@.@1) LMAX = LMAX+1 MAIN212¢ 
DO 32 I=1,N MAIN213@ 
DO 32 J=1,N MAIN214¢ 

DO 28 K=1,N1 MAIN215@ 

A(K) = A2(K,I,J) MAIN216@ 

oD MAIN217@ 

CALL MRADIX(A,N1,C,LMAX,L,B, IER) MAIN218¢ 

DO 29 K=1,L MAIN219¢ 
A2(K,1I,J) = C(K) MAIN2260 

OD MAIN2216 

IF (L.LT.NL) GOTO 30 MAIN222¢ 

GOTO 32 MAIN2230 

THEN MAIN224@ 

Ll = L+tl MAIN225@ 

DO 31 K=L1,N1 MAIN226@ 
A2(K,I,J) = @ MAIN227@ 

6)0) MAIN2280 

OD MAIN229¢ 

OD MAIN23¢¢ 
CONTINUEMAIN231@ 

DO 37 I=1,N MAIN2326 
DO 37 J=1,M MAIN233@ 

DO 33 K=1,N1 MAIN2346 

A(K) = B2(K,I,J) MAIN235@ 

oD MAIN236@ 

CALL MRADIX(A,N1,C,LMAX,L,B, IER) MAIN237@ 

DO 34 K=1,L MAIN2386 
B2(K,I,J) = C(K) MAIN239@ 

OD MAIN2460 

IF (L.LT.N1) GOTO 35 MAIN241¢ 

GOTO 37 MAIN242@ 

THEN MAIN2430 

Ll = L+l MAIN2440 
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DO 36 K=L1,N1 


36 B2(K,1,J) = @ 
C OD 
C OD 
C OD 
37 
c 
C **kPRINT A2 AND B2 IN MIXED-RADIX FORM. 
Cc 
WRITE (6,45) 
DO 39 K=1,T 
WRITE(6,46) K 
DO 38 I=1,N 
38 WRITE(6,47) (A2(K,1I,J),J=1,N) 
C OD 
39 
c OD 
WRITE (6,48) 
DO 41 Ke=1,T 
WRITE(6,49) K 
DO 4¢ I=1,N 
4d WRITE(6,47) (B2(K,1,J) ,J=1,M) 
C oD 
4l 
C OD 
C 
C **COMPUTE MAXPRM. 
C 


TWOT] = 2*T+1 

CALL SUBBND(A2,B2,GAMMA,DELTA,S,SUM,T,N,M,NM, 
1 TWOT 1, BOUND , MAXPRM) 

WRITE(6,50) BOUND ,MAXPRM 


C 
Cc **SOLVE THE SYSTEM OF LINEAR EQUATIONS A2*X=B2. 
C 
CALL DRIVER(A2,B2,AMOD,T,N,M,NM,Y,DET,MAXPRM, B) 


42  FORMAT(1H1, 16X, SHINPUT/17X,5(1H*) /5X, 
i 38HFIXED-RADIX REPRESENTATION, BASE=16000/10x, 
2 4@HA = A(1L,N,N)+A(2,N,N)*BASE+...+A(T,N,N)*, 
3 1 LHBASE** (T-1) ) 
43 FORMAT(5X, 20(14, 2X)) 
44  FORMAT(/10X,4@HB = B(1,N,M)+B(2,N,M)*BASE+. ..+B(T,N,M)*, 


1 L1HBASE** (T-1) ) 

45 FORMAT (/5X, 26HMIXED-RADIX REPRESENTATION/ 10x, 
1 4QHA = A(1,N,N)+A(2,N,N)*P(1)+...+A(T,N,N)*, 
2 15HP(1)*...*P(T-1)) 


46  FORMAT(/1@X, 2HA(,11,5H,N,N)) 

47 FORMAT(1H ,20(I6)) 

48  FORMAT(/1@X,4@HB = B(1,N,M)+B(2,N,M)*P(1)+...+B(T,N,M)*, 
1 15HP(1)*...*P(T-1)) 

49 FORMAT (/1@X, 2HB(,11,5H,N,M)) 

5@  FORMAT(/1@X,13HLOG(BOUND) = ,F8.4,2X,9HMAXPRM = ,13) 
STOP 
END 


ce 
CHKERKRKKKEKKKEKKKEKARUK KEE KERKKKEAAKKKEKKEKRKKRERKKKKAKKKKEKKARKKKKK KKK 
Cc * 
Cc CALL ESOLVE. x 
Cc PRINT OUTPUTS IN MIXED-RADIX FORM. * 
Cc CALL FRADIX. * 
Cc PRINT OUTPUTS IN FIXED-RADIX FORM. * 
C * 
CREEKRKKKKKKKKEKRKKKKEREKK EKER KKKEKKKKKKRK AKER KKK KKERAKKKKKK 
Cc 

SUBROUTINE DRIVER(A,B,AMOD,T,N,M,NM,Y,DET,MAXPRM, BASE) 

INTEGER T,A(T,N,N),B(T,N,M) ,AMOD(N,NM) ,Y (MAXPRM,N,M) , 

1 DET (MAXPRM) , BASE, P (100) 

INTEGER A1(1@),C1(10) 

COMMON /PRIMEB/ P, IPRIME(140) 

LOGICAL RTEST 
Cc 


C **SOLVE THE SYSTEM OF LINEAR EQUATIONS AX=B. 


MAIN245@ 
MAIN246@ 
MAIN247@ 
MAIN248@ 
MAIN249@ 


CONTINUEMAIN25@@ 


MAIN251¢ 
MAIN25 20 
MAIN253@ 
MAIN254@ 
MAIN255@ 
MAIN2560 
MAIN257@ 
MAIN258¢@ 
MAIN259¢ 


CONTINUEMAIN260@ 


MAIN261@ 
MAIN262¢ 
MAIN263@ 
MAIN2646 
MAIN265¢@ 
MAIN266@ 
MAIN267@ 


CONTINUEMAIN268@ 


MAIN269@ 
MAIN270@ 
MAIN271¢ 
MAIN272@ 
MAIN273@ 
MAIN274@ 
MAIN275@ 
MAIN276@ 
MAIN277@ 
MAIN278@ 
MAIN279@ 
MAIN2800 
MAIN281¢ 
MAIN2820 
MAIN283@ 
MAIN284¢ 
MAIN285@ 
MAIN286@ 
MAIN287@ 
MAIN288@ 
MAIN289@ 
MAIN2906¢ 
MAIN291¢ 
MAIN292@ 
MAIN293@ 
MAIN294@ 
MAIN295@ 
MAIN296@ 
MAIN297@ 
MAIN298¢@ 
MAIN299@ 


DRLVOOIO 
DRLVOO20 
DR1VOO3O 
DR1VOO40 
DRIVGOSA 
DRIVOOED 
DRIVOO70 
DRIVOO8BO 
DRIVQA9O 
DRLVO1IAO 
DRIVG1L1O 
DRIVO12¢ 
DRIVG13@ 
DRIV 46@ 
DRIV 14¢ 
DRIVO150 
DRIVO16¢ 
DRIV@17¢0 
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C 


aan 


Aaa 


aqgaaAaAN 


RTEST = .TRUE. 


CALL ESOLVE(A,B,AMOD,T,N,M,NM,DET,Y,MAXPRM, NOCOEF, 


1 RTEST, IER) 


1 


**kPRINT OUTPUT PARAMETERS. 
WRITE(6,6) IER,NOCOEF 
**PRINT Y IN MIXED-RADIX FORM. 
WRITE (6,7) 
DO 2 J=1,M 
WRITE(6,8) J 
DO 1 I=1,N 
WRITE(6,16) (¥(K,I,J) ,K=1,NOCOEF) 
oD 
oD 
**PRINT DET IN MIXED-RADIX FORM. 


WRITE(6,9) 
WRITE(6,16) (DET(K) ,K=1,NOCOEF) 


**XCONVERT Y AND DET FROM MIXED-—RADIX TO FIXED-RADIX FORM. 


**PRINT Y AND DET IN FIXED-RADIX FORM. 


TEMP = (FLOAT (NOCOEF)*ALOG(FLOAT(P(NOCOEF))) - ALOG(2.0)) / 


ALOG (FLOAT (BASE) ) 
LMAX = TEMP 
IF (TEMP-FLOAT(LMAX).GT.@.@1) LMAX = LMAX+1 
WRITE(6,11) 
DO 5 J=1,M 
WRITE(6,8) J 
DO 4 I=1,N 
DO 3 K=1,NOCOEF 
C1(K) = Y(K,I,J) 
OD 
CALL FRADIX(C1,NOCOEF,Al,LMAX,L, BASE, IER) 
WRITE(6,16) (A1(II),II=1,L) 
OD 


oD 
CALL FRADIX (DET, NOCOEF,Al,LMAX,L, BASE, IER) 
WRITE(6,12) (A1(I),I#1,L) 


FORMAT (/16X, 7HOUTPUTS/16X, 7(1H*) /6X, 


6HIER = ,13,5X,9HNOCOEF = ,I3) 


7 FORMAT (/16X,21HY IN MIXED-RADIX FORM/14x, 


FWNHre 


1 
2 
3 
4 


19 
11 


PWN Fe 


12 


1 
2 
3 
4 


FORMAT 


35HFROM LEFT TO RIGHT, THE NUMBERS ARE, 
25H COEF(1),...,COEF(L), AND/19Xx, 

33HY (I,J) = COEF(1)+COEF(2)*P(1)+..., 
23H+COEF (L)*P(1)*...P(L-1)) 


FORMATO) LOX, SHY CLAN aT LED) pADIX FORM/10X, 


35HFROM LEFT TO RIGHT, THE NUMBERS ARE, 
24H COEF(1),...,COEF(L) ,AND/16xX, 

3QHDET = COEF(1)+COEF(2)*P(1)+..., 
23H+COEF (L)*P(1)*...P(L=1)) 

FORMAT (16X, 2 (16) ) 

FORMAT (/16X,21HY IN FIXED-RADIX FORM/1@x, 
35HFROM LEFT TO RIGHT, THE NUMBERS ARE, 
24H COEF(1),...,COEF(L) ,AND/1@X, 
37HY(I,J) = COEF(1)*BASE** (L-1)+COEF (2)*, 
23HBASE** (L-2)+.. .+COEF(L)) 

FORMAT (/16X,23HDET IN FIXED-RADIX FORM/1@xX, 
35HFROM LEFT TO RIGHT, THE NUMBERS ARE, 
24H COEF(1),...,COEF(L) ,AND/10x, 
34HDET = COEF (1)*BASE** (L-1)+COEF (2)*, 
21HBASE(N-2)+.. .+COEF (L) /16X,16(16)) 

RETURN 

END 


DRIVG18¢ 
DRIVG19¢ 
DRIVG2G¢ 
DRIVG21¢ 
DRIVGO22¢ 
DRIVO23¢ 
DRIVG24¢ 
DRIV@25@ 
DRIVO26¢ 
DRIVG27¢ 
DRIVO280 
DRIVG29¢ 
DRIVG300 
DRIVG31¢ 
DRIVG32¢ 
DRIVO33¢ 
DRIVO34@ 


CONTINUEDRIV@35@ 


DRIVO360 
DRIVO370 
DRIVO38¢ 
DRIVG39¢0 
DRIVO4G0 
DRIVG41¢ 
DRIVO4 20 
DRIVO430 
DRIVG440 
DRIVO45@ 
DRIVO47@ 
DRIVG480 
DRIVO490 
DRIVG500 
DRIVO51¢ 
DRIVG520 
DRIVG530 
DRIV@540 
DRIVO55¢ 
DRIVO560 
DRIV@57@ 
DRIVG580 
DRIVG59@ 
DRIVO6GO 


CONTINUEDRIVG61¢ 


DRIVQ6 20 
DRIVG63¢ 
DRIVO640 
DRIVG65¢@ 
DRIVG660 
DRIVG670 
DRIVG68G 
DRIVG690 
DRIVO706@ 
DRIVG71¢ 
DRIVO72@ 


DRIV 73 
BRT VOoz0 


DRIVO75@ 
DRIVO76@ 
DRIVO77¢ 
DRIVO78@ 
DRIVO79@ 
DRIVG8OO 
DRIVG81¢ 
DRIVG82¢ 
DRIVO83¢ 
DRIVG84@ 
DRIVG85¢ 
DRIVG86O 
DRIVO87¢ 
DRIVO88¢ 
DRIVO89@ 
DRIVGIGOD 
DRIVG91¢ 
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AAANAQAAAAQAAQANQNANQAAQAQAQANANQANAQQANANQNAAANQAAANAANAAANRNANAAANRANANAnNNNaAanAaAaANnNnaanRganannnnnaananaan 


SUBROUTINE ESOLVE(A,B,AMOD,T,N,M,NM,DET,Y,MAXPRM, NOCOEF, 
1 RTEST, LER) 


RRKEKKREKKERKREKEERKKKERKEAKEREKEREEKERRRERERKEKRKKEKRKKREKKRKKKAKKKKEE 
* 

THIS SUBROUTINE SOLVES EXACTLY THE SYSTEM OF LINEAR EQUATIONS* 
AX=B, WHERE A( ,N,N) AND B( ,N,M) ARE MATRICES WITH MULTIPLE-* 
PRECISION INTEGER COEFFICIENTS EXPRESSED IN MIXED-RADIX oe * 

THE SUBROUTINE NORMALLY RETURNS INTEGER VALUES FOR 

DET=DETERMINANT(A) AND Y*A(ADJOINT)*B, ALSO IN MIXED-RADIX * 
FORM. IF THE SOLUTION X IS REQUIRED, THE USER NEED ONLY x 
COMPUTE X=Y/DET. (FOR CONVERSION OF INTEGERS FROM MIXED- * 
RADIX ‘TO FEXED-RADTX FORMS AND CONVERSELY, SUBROUTINES FRADIX* 
AND MRADIX CAN BE USED.) 


PRIME IS A LINEAR ARRAY CONTAINING 16@ DISTINCT PRIME 
(INPUT) INTEGERS IN ASCENDING ORDER. THE PRIMES ARE CHOSEN 
AS LARGE AS POSSIBLE SUBJECT TO THE CONDITION THAT 
FOR ALL I AND J PRIME(1)*PRIME(J) DOES NOT OVERFLOW 
AN INTEGER WORD. THESE PRIMES ARE USED AS RADII FOR 
THE REPRESENTATION OF INTEGERS IN MIXED-RADIX FORM. 
IPRINE IS A LINEAR ARRAY OF INTEGERS SUCH THAT FOR EACH Kk, 
(INPUT) IPRIME(K)* PRIME(1L)*PRIME(2)*...*PRIME(K-1) = 1, 
MODULO PRIME(K). 
A 1S AN INTEGER MATRIX OF DIMENSION T BY N BY N. THE 
(INPUT) FIRST DIMENSION CONTAINS THE COEFFICIENTS OF THE 
MIXED-RADIX REPRESENTATION OF THE MUL'ITIEPLE-PRECISION 
COMPONENTS OF THE N BY N MATRIX AC ,N,N). THAT IS, 
A( ,I,J) = A(1,1,J) 
+ A(2,1,J)*PRIME(1) 


+ A(T,I,J)*PRIME(1)*.. 
FOR I,J=1,2, »N. 

B IS AN INTEGER “MATRIX OF DIMENSION T BY N BY M WITH 
(INPUT) A SIMILAR NOTATIONAL CORRESPONDENCE MADE FOR A ABOVE. 
AMOD 1S AN N BY N+M MATRIX USED FOR TEMPORARY STORAGE OF 
(TEMP) THE AUCMENTED MATRIX (A,B) MODULO THE VARIOUS PRIMES 


.*PRINE(T-1), 


+r eee eee He HEHEHE EEE EH Ee HEHEHE HEHEHE EHH 


PRIME(K). THIS MATRIX IS INCLUDED IN THE ARGUMENT 
LIST ONLY TO PERMIT ITS DIMENSIONS TO BE VARIABLE. 
T IS THE NUMBER OF RADII, PRIME(1),...,PRIME(T), USED 
(INPUT) TO REPRESENT EACH COMPONENT OF AC ,N,N) AND BC ,N,M) 
IN MIXED-RADLX FORM. 
N IS THE NUMBER OF EQUATIONS AND THE NUMBER OF iumouNet 
(INPUT) IN THE SYSTEM. (1.E., N 1S THE SIZE OF THE SECOND * 
AND THIRD DIMENSIONS OF A.) * 
M IS THE NUMBER OF RIGHT-HAND VECTORS FOR WHICH THE * 
CINPUT) SYSTEM IS TO BE SOLVED. (I.E., M IS THE SIZE OF THE * 
THIRD DIMENSION OF B.) * 
NM IS EQUAL TO N+M. * 
(INPUT) * 
DET IS A VECTOR OF DIMENSION MAXPRM WHICH CONTAINS THE * 
(OUTPUT) COEFFICIENTS OF THE MIXED-RADIX REPRESENTATION OF * 
DETERMINANT (A) * 
= DET(1) * 
+ DET(2)*PRIME(1) 7 
* 
; * 
+ DET (MAXPRM)*PRIME(1)*...*PRIME(MAXPRM-1). * 
Y IS A MATRIX OF DIMENSION MAXPRM BY N BY M. THE FIRST* 
(OUTPUT) DIMENSION CONTAINS THE COEFFICIENTS OF THE MIXED- * 
RADIX REPRESENTATION OF Y( ,N,M) = A(ADJOINT)*B: * 
X¥( ,I,J) - 
= Y(1,I,J) * 
+ Y(2,1,J)*PRIME(1) * 
‘ ° * 
2 * 
; * 
+ Y(MAXPRM,I,J)*PRIME(1)*...*PRIME(MAXPRM-1). * 
MAXPRM IS THE MAXIMUM NUMBER OF RADII, PRIME(1),..., * 
(INPUT) PRIME (MAXPRM), REQUIRED TO REPRESENT DETERMINANT(A) * 
AND A(ADJOINT)*B IN MIXED-RADIX FORM. MAXPRM SHOULD * 
BE CHOSEN SO THAT x 
ABS (DETERMINANT (A)), ABS(Y( ,I,J)) * 


ESOLO@10 
ESOLM#20 
ESOL(O3@ 
LESOLOHO46 
ESOL@O5@ 
ESOLO(60 
ESOLG070@ 
ESOLOG80 
ESOLOO90 
ESOLQ10@ 
ESOL@110 
ESOLOL26 
KSOLPL IG 
ESOLO@L4G 
ESOLQ15¢@ 
ESOL@160 
ESOL@170 
ESOL@18¢ 
ESOL@19¢ 
ESOLO20@ 
ESOL@21¢ 
ESOL@2206 
ESOLO23@ 
ESOL@24@ 
ESOLQ@25@ 
ESOLO260 
ESOLO27¢@ 
ESOLO280 
ESOL629@ 
ESOLO300 
ESOL@31¢ 
ESOL@32@ 
ESOLO33@ 
FSOLO34@ 
ESO1O35@ 
ESOLO36@ 
ESOL@370@ 
ESOLG38@ 
ESOL@39@ 
ESOLG406@ 
ESOL@41@ 
ESOLQ4 24 
ESOLQ4 30) 
ESOLO446 
ESOL@450 
ESOL@46@ 
ESOL@470 
ESOL@480 
ESOLO49@ 
ESOL@500 
ESOL@51¢@ 
ESOL@5 20 
ESOL@53@ 
ESOLO54@ 
ESOLO55@ 
ESOL@56¢@ 
ESOL@570@ 
ESOL@58¢@ 
ESOL@59@ 
ESOL@600 
ESOLG61¢ 
ESOLG62¢ 
ESOL@63@ 
ESOLG640 
ESOL@65¢ 
ESOLG660@ 
ESOL@670 
ESOL@68@ 
ESOL@69¢ 
ESOLO760 
ESOLO71¢ 
ESOL@72@ 
ESOLO73@ 
ESOL@74@ 
ESOL@75@ 
ESOLO760 
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< PRIME(1)*...*PRIME(MAXPRM)/2, I=1,2,...,N, 
J=1,2,..05M. 
CHOOSING MAXPRM = N*T + N*LOG(N) /(2*LOG(PRIME(1))) 
WILL SUFFICE. (A TIGHTER BOUND CAN BE OBTAINED USING 
SUBROUTINE SUBBND.) MAXPRM MUST BE LESS THAN 101. 
C NOCOEF IS THE NUMBER OF RADII ACTUALLY USED TO REPRESENT 
C(OUTPUT) DET AND Y¥( ,I,J) IN MIXED-RADIX FORM. 
NOCOEF <= MAXPRM. 
RTEST IF RTEST = .FALSE. , MAXPRM COEFFICIENTS IN THE 
(INPUT) MIXED-RADIX REPRESENTATION OF DET AND Y( ,N,M) 
ARE COMPUTED. 
IF RTEST = .TRUE. , THE ALGORITHM CONTINUES TO 
ITERATE UNTIL TR (USUALLY TR=T, BUT SOMETIMES 
TR=T+1) SUCCESSIVE ZERO COEFFICIENTS IN THE 
MIXED-RADIX REPRESENTATION OF DET AND Y( ,N,M) 
ARE ENCOUNTERED, THAT IS, WHENEVER FOR 
K = NOCOEF+1,...,NOCOEF+TR (NOCOEF+TR <= MAXPRM), 
DET(K) = @ 
Y(K,1,J) = O, I=1,2,...,N, Jal,2,...,M. 
IF NOCOEF > @, THE PROGRAM TERMINATES WITH THE 
KNOWLEDGE THAT 
(1) A IS SINGULAR IF DET=@, OR 
(2) Y( ,N,M)/DET IS THE SOLUTION TO AX=B IF 
DET —=@. (*WARNING* IN THIS CASE, A COMMON 
FACTOR IN Y( ,N,M) AND DET MAY HAVE 
BEEN IGNORED. THAT IS, DET MIGHT NO 
LONGER BE THE DETERMINANT OF A.) 
IF NOCOEF = ¢, A IS PROBABLY SINGULAR, BUT THE 
PROGRAM CONTINUES TO ITERATE UNTIL MAXPRM 
COEFFICIENTS OF DET AND Y( ,N,M) HAVE BEEN 
COMPUTED. 
IER IS AN ERROR CODE WHICH IS 
(OUTPUT) @ IF Y¥( ,N,M)/DET IS THE SOLUTION TO AX=B. 
(XWARNING* DET MIGHT NOT BE THE DETERMINANT OF A) 
1 IF MAXPRM COEFFICIENTS IN THE MIXED-RADIX 
REPRESENTATION OF DET AND Y( ,N,M) HAVE BEEN 
COMPUTED. SINCE THE USER CHOOSES THE VALUE OF 
MAXPRM, THE PROGRAM CANNOT GUANENTEE THAT 
¥( ,N,M)/DET IS THE SOLUTION TO AX=B. 
2 IF A IS SINGULAR. 
3 IF A IS SINGULAR, OR DET AND Y( ,N,M) ARE NON-ZERO* 
MULTIPLES OF PRIME(1)*...*PRIME(MAXPRM) . 


4 IF THE INPUT PARAMETERS ARE INCORRECT. * 
* 


KKKREKKEKKKEKKEKEREKEKREKRRERKREEKKAKERERKEKERKEREEKKEREKKRKERKKKKKAKRE 


AaAAaAND 


tee + eHtHeEHeE HH HEHEHE HHHe HHH HH SE eH HS 


AAQANQANDAANQGDAQANAANAAAAQAANAAGAANQNQAAANQAAAANAARAAaAARN 
++ ee FH HH OF 


INTEGER T,TR,A(T,N,N) ,B(T,N,M) ,DET (MAXPRM) , Y (MAXPRM,N,M) , 
i AMOD (N, NM) 

LOGICAL RTEST 

INTEGER PT,TK,TT,TT1,DMOD,V1,V3,U1,U3,T1,T3,Q 

INTEGER PRIME(1006) , IPRIME(1@06) ,P,P1,P2 

LOGICAL TEST 

COMMON /PRIMEB/PRIME, IPRIME 

TER=4 

IF (MAXPRM.GT.16@ .OR. N.LT.2 .OR. M.LT.1) RETURN 

IF (N+M.NE.NM) RETURN 


Nl = N+l 
c 
Cc PROCEDURE ZERO—-CRITERION ®&XXRKKAAKAKKAKARKKAAKRERREREERKERE 
c DETERMINED IN THIS PROCEDURE IS THE NUMBER TR OF * 
c CONSECUTIVE ZERO COEFFICIENTS IN THE MIXED-RADIX * 
c REPRESENTATION OF DET AND Y REQUIRED TO GUARANTEE THAT* 
c X=Y/DET IS THE SOLUTION OF AX=B. TR=T IF NORM INFINITY* 
C OF THE MATRIX A AUGMENTED BY ANY COLUMN VECTOR OF B IS* 
c BOUNDED BY 2*PRIME(1)*...*PRIME(T); OTHERWISE, TR=T+1.* 
GC k 
TR=T 
IF (RTEST) GOTO 1 
GOTO 6 
C THEN 
1 PT = 2*PRIME(T) 
I= 96 
Cc REPEAT ... FOR EACH ROW I 
2 I = I+1 
IF (I.LE.N .AND. TR.EQ.T) GOTO 3 
GOTO 6 


ESOL@770 
ESOL@78@ 
ESOLQ79¢@ 
ESOLO8@¢ 
ESOL@81@ 
ESOLG82¢ 
ESOL@83@ 
ESOLG84@ 
ESOLG85¢ 
ESOLO860 
ESOLG87@ 
ESOLO88¢ 
ESOL@89@ 
ESOLG90@ 
ESOLG91¢ 
ESOL@9 20 
ESOLG93¢ 
ESOLG94@ 
ESOLG95@ 
ESOLG96@ 
ESOLQ97@ 
ESOL@98¢@ 
ESOLG99@ 
ESOL160¢ 
ESOL161¢ 
ESOL192¢ 
ESOL1063@ 
ESOL164¢ 
ESOL1065¢ 


ESOL1060 
ESOL197@ 


ESOL1 986 
ESOL1099¢ 
ESOL116¢ 
ESOL1110@ 
ESOL112@ 
ESOL113@ 
ESOL114@ 
ESOL115¢@ 
ESOL116@ 
ESOL117¢ 
ESOL118@ 
ESOL119¢ 
ESOL1200 
ESOL121¢ 
ESOL122@ 
ESOL123¢ 
ESOL124¢ 
ESOL125@ 
ESOL1260 
ESOL1270 
ESOL128¢ 
ESOL129¢ 
ESOL130@ 
ESOL131¢ 
ESOL132@ 
ESOL133@ 
ESOL134@ 
ESOL135¢ 
ESOL136¢ 
ESOL137@ 
ESOL138¢@ 
ESOL139@ 
ESOL14¢6¢ 
ESOL141¢ 
ESOL142@ 
ESOL143@ 
ESOL144@ 
ESOL1450@ 
ESOL146@ 
ESOL147@ 
ESOL148@ 
ESOL149@ 
ESOL15@@ 
ESOL151@ 
ESOL1520 
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C 


AAANA 


APQAQAAANAAAANANAAN 


THEN ESOL153@ 

3 NORM = @ ESOL154@ 
DO 4 J=1,N ESOL155@ 

4 NORM = NORM + IABS(A(T,I,J)) ESOL156@ 
OD ESOL157@ 

MAXB = @ ESOL158@ 

DO 5 J=1,M ESOL159@ 

5 IF (MAXB.LT.IABS(B(T,I,J))) ESOL160@ 
1 MAXB = IABS(B(T,I,J)) ESOL161@ 

OD ESOL162@ 

NORM = NORM + MAXB ESOL163@ 

IF (T.GT.1) NORM = NORM + NI ESOL164@ 

**kHERE, USED IS THE FACT THAT FOR Til ESOL1650@ 

** (ABS (K(T)+1)*PRIME(1)*...*PRIME(T-1)) IS ESOL166@ 

**kA BOUND FOR ANY INTEGER GIVEN BY ESOL1670 

**K (1)+K (2) *PRIME(1)+.. .+K(T)*PRIME(1)* ESOL168@ 
**,..*PRIME(T-1). ESOL169@ 

IF (NORM.GT.PT) TR = T+l ESOL1700 

CONTINUE ESOL1710@ 

GOTO 2 ESOL172¢ 

* ESOL173@ 

END ZERO--CRITERION *&XAKAAHKRARAKKKKKAKARAREKEREKEKARKE ESOL174@ 
ESOL175@ 

6 NOZERO = @ ESOL176@ 
DO 64 ITER=1,MAXPRM ESOL177¢ 
**kTHE SYSTEM AX=B IS SOLVED MODULO PRIME(ITER) FOR ALL ESOL178@ 
*kITER = 1,2,...,MAXPRM, OR IF RTEST IS TRUE UNTIL ESOL179¢ 

**THE NUMBER OF CONSECUTIVE ZERO COEFFICIENTS (NOZERO) ESOL18¢6@ 

**IN THE MIXED-RADIX REPRESENTATION OF DET AND Y IS ESOL181¢ 
**EQUAL TO TR. ESOL182@ 

P = PRIME(ITER) ESOL183@ 

Pl = P-] ESOL184@ 

P2 = P1/2 +1 ESOL185@ 

IP = IPRIME(ITER) ESOL186@ 
ESOL187@ 

PROCEDURE MAP KXRKKKKRKKKKKKKKKEEKKAKEREREKKKKKEKREKEKKER ESOL1L88@ 

THIS PROCEDURE COMPUTES AMOD, THE AUGMENTED * ESOL189¢ 

N BY N+M MATRIX (A,B) MODULO P. THAT IS, FOR * ESOL190¢ 
I=1,2,...,N, HORNER'S RULE AND MODULO P ARITHMETIC * ESOL191¢ 

IS USED TO COMPUTE x ESOL192@ 
AMOD(I,J) = ACQ1,1I,J) + A(2,1,J)*PRIME(1) + * ESOL193@ 

wee + ACT,I,J)*PRIME(1)*...*PRIME(T-1) ,* ESOL194@ 

J=l,2,...,N,% ESOL1950@ 

AMOD(I,J+N) = B(1,I,J) + B(2,1,J)*PRIME(1) + * ESOL196@ 

eee + B(T,I,J)*PRIME(1)*...*PRIME(T-1) ,* ESOL1970 

J=1,2,...,M.% ESOL198@ 

* ESOL199¢@ 

TT = MIN@(T, ITER) ESOL2¢00 

TTl = TT-1 ESOL2@1@ 

IF (TT.EQ.1) GOTO 7 ESOL2¢2¢ 

GOTO 11 ESOL203¢ 

THEN ESOL264@ 

7 DO 1¢ I=1,N ESOL265@ 
DO 8 J=1,N ESOL206@ 

8 AMOD(I,J) = A(1,1,J) ESOL207@ 
OD ESOL2068@ 

DO 9 J=1,M ESOL209@ 

NJ = Nt+J ESOL210@ 

9 AMOD(I,NJ) = B(1,I,J) ESOL211¢ 
OD ESOL212@ 

OD ESOL213@ 

10 CONTINUEESOL214¢ 
GOTO 17 ESOL215¢ 

ELSE ESOL216¢ 

11 DO 16 I=1,N ESOL2170 
DO 13 J=1,N ESOL2180@ 

NTEMP = A(TT,I,J) ESOL219@ 

DO 12 K=1,TT1 ESOL2200 

TK = TT -K ESOL221¢ 

12 NTEMP = MOD (PRIME(TK)*NTEMP+A (TK,1I,J) ,P) ESOL222@ 
OD ESOL223@ 

13 AMOD(I,J) = NTEMP ESOL224@ 
OD ESOL225@ 

DO 15 J=1,M ESOL226@ 

NTEMP = B(TT,I,J) ESOL227@ 


DO 14 K=1,TTl 


ESOL228@ 
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14 


C 


15 


16 


AAQAQANANAAARAAANANANAAanNAnKDANRAA 


17 


25 


aNgaAAN 


26 


T = TT -K 
NTEMP = MOD (PRIME(TK)*NTEMP+B(TK,1,J),P) 
OD 
NJ = N+J 
AMOD(I,NJ) = NTEMP 
oD 
OD 
CONTINUE 
END MAP 8EXKAKKAKKERKKKKKKRKKKKERKEKEKKEKERKKEAKRKEKKAKKKK 
PROCEDURE MSOLVE KREKKKKKEKERREKRKREREKEEKKKKKK KK KKK 
THIS PROCEDURE SOLVES THE SYSTEM OF EQUATIONS * 
AX=B MODULO P BY COMPUTING x 
DMOD = DETERMINANT(A) MOD P * 
AND * 
A(ADJOINT)*B MOD P, * 
WHICH IS TEMPORARILY STORED IN Y(ITER,I,J), * 
Iml,2,...,N, Jml,2,...,M. x 
* 
THE GAUSSIAN ELIMINATION METHOD WITH PARTIAL * 
PIVOTING IS USED TO REDUCE A TO UPPER ECHELON * 
FORM. * 
* 
NSING ASSUMES THE VALUE x 
@, IF A HAS RANK N, MOD P * 
1, IF A HAS RANK N-1, MOD P * 
2, IF A HAS RANK SMALLER THAN N-1, MOD P * 
* 
KRAM IS EQUAL TO N IF A IS NONSINGULAR MODULO P; * 
OTHERWISE, KRAM IS THE INDEX OF THE FIRST * 
COLUMN WHICH CONTAINS A ZERO PIVOT ELEMENT. * 
* 
DMOD = 1 
NSING = @ 
II = @ 
REPEAT ... FORWARD ELIMINATION WITH II AS THE PIVOT 
. COLUMN 
II = II+l 
IF (NSING.LT.2 .AND. II.LE.N) GOTO 19 
GOTO 34 
THEN 
I = II - NSING 
**ELIMINATION PROCEEDS ON THE SUBMATRIX WITH 
**ROWS I,I+1,...,N AND COLUMNS II,II+1,...,N+M 
Il = I+l 
IIl = II+l 
K = I-l 
REPEAT ... SEARCH FOR NON-ZERO ELEMENT IN 
. II'TH COLUMN. 
K = K+l 
IF (K.LE.N) GOTO 21 
GOTO 22 
THEN 
IF (AMOD(K,II) .NE.@) GOTO 22 
GOTO 2¢ 
THEN 
rr EXIT 
CONTINUE 
IF (K.LE.N) GOTO 23 
GOTO 33 
THEN ... AMOD(K,II) IS THE PIVOT ELEMENT 
IF (K.NE.I) GOTO 24 
GOTO 26 
THEN ... INTERCHANGE ROWS I AND Kk 
DO 25 J=I1,NM 
NTEMP = AMOD(I,J) 
AMOD (I,J) = AMOD(K,J) 
AMOD(K,J) = NTEMP 
OD 
DMOD = -DMOD 
PROCEDURE INVERT #&XRXRRRKKKEEEEKEKKEEKEREEKE 
EUCLID'S EXTENDED ALGORITHM IS USED TO * 
FIND THE INVERSE, VI, MODULO P OF * 
AMOD(I,II). * 
Vl =1 


ESOL229¢ 
ESOL230¢ 


ESOL231¢ 
ESOL232@ 


ESOL2330 
ESOL234@ 
ESOL235@ 


ESOL2 360 
ESOL237¢ 


ESOL238@ 
ESOL239@ 
ESOL2406@ 
ESOL241¢ 
ESOL2420@ 
ESOL243¢ 
ESOL2449@ 
ESOL245¢@ 
ESOL246@ 
ESOL247@ 


ESOL248¢@ 
ESOL2496 


ESOL250@ 
ESOL251¢ 
ESOL2526 
ESOL253¢ 
ESOL254@ 
ESOL255¢ 
ESOL256@ 
ESOL257@ 
ESOL258@ 
ESOL259@ 
ESOL2600 
ESOL2610 
ESOL262@ 
ESOL263@ 
ESOL264@ 
ESOL265@ 
ESOL2666 
ESOL267@ 
ESOL2680 
ESOL269@ 
ESOL270@ 
ESOL271¢ 
ESOL272@ 
ESOL273@ 
ESOL274@ 
ESOL275@ 
ESOL276¢ 
ESOL277@ 
ESOL278@ 
ESOL279@ 
ESOL2800 
ESOL2816 
ESOL282@¢ 
ESOL283@ 
ESOL284@ 
ESOL285@ 
ESOL2860@ 
ESOL287@ 
ESOL288@ 
ESOL289@ 
ESOL2906@ 
ESOL2910@ 
ESOL292@ 
ESOL293@ 
ESOL294@ 
ESOL295¢@ 
ESOL296@ 
ESOL297¢ 
ESOL298@ 
ESOL299@ 
ESOL300@ 
ESOL3@1¢@ 
ESOL3062@ 
ESOL303@ 
ESOL304@ 
ESOL3@5@ 
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28 


37 
38 


39 


ELSE 


CONTINUE 


Ul = @ 
V3 = IABS(AMOD(I,II)) 
U3 = P 
REPEAT 
IF (V3.NE.1) 
THEN 
Q = U3/V3 
Tl = Ul - Q*vl 
T3 = U3 — Q*V3 
Ul = Vl 
U3 = V3 
Vl = Tl 
V3 = 73 
CONTINUE 


IF (AMOD(I,II).LT.@) V1 = -V1 
* 
END INVERT #X&AARAKAAAKAKKARARRARARARKAARARE 


DMOD = MOD(DMOD*AMOD(1,II) ,P) 
DO 3@ J=II1,NM 
AMOD(I,J) = MOD(V1*AMOD(I,J),P) 
oD 
IF (I.LT.N) 


THEN 
DO 32 K=I1,N 
NTEMP = AMOD(K, II) 
DO 32 J=II1,NM 
AMOD(K,J) = MOD(AMOD(K,J) - NTEMP* 
AMOD(I,J) ,P) 
oD 
oD 


-.. COLUMN II IS A ZERO PIVOT COLUMN. 
NSING = NSING + 1 
IF (NSING.LT.2) KRAM = II 


IF (NSING.LT.2) 


THEN ... 


RANK OF A MODULO P IS N OR N-1; THEREFORE 
BACK SUBSTITUTE. 


IF (NSING.EQ.@) KRAM = N 


KRAM1 
KRAM2 
DO 41 
NJ 
IF 


= KRAM - 1 
= KRAM + 1 
J=N1,NM 
=J-N 
(KRAM.NE.N) 


THEN 


DO 37 I=KRAM2,N 
Y(ITER,I,NJ) = @ 
oD 


NTEMP = MOD (DMOD*AMOD(N,J) ,P) 


IF 


(NSING.EQ.1) NTEMP = NTEMP*(-1)**(N-KRAM) 


Y(ITER,KRAM,NJ) = NTEMP 


DO 


oD 
ot) 


ELSE ... 
DO 43 


4@ II=1,KRAM1 
I = KRAM - II 
Il = I+l 
NTEMP = @ 
DO 39 K=I1,KRAM 
NTEMP = MOD (NTEMP-+AMOD (I,K) * 
Y(ITER,K,NJ), P) 
OD 
NTEMP = -NTEMP 
IF (NSING.EQ.6) NTEMP = MOD(NTEMP + DMOD* 
AMOD (I,J) ,P) 
Y(ITER,I,NJ) = NTEMP 


RANK OF A MODULO P IS LESS THAN N-1. 
J=1,M 


GOTO 28 
GOTO 29 


GOTO 27 


GOTO 31 
GOTO 34 


GOTO 18 


GOTO 18 


GOTO 35 
GOTO 42 


GOTO 36 
GOTO 38 


ESOL3066@ 
ESOL3070 
ESOL3068@ 
ESOL3069¢ 
ESOL316@ 
ESOL311@ 
ESOL3120 
ESOL313@ 
ESOL314@ 
ESOL315@ 
ESOL316@ 
ESOL317@ 
ESOL318@ 
ESOL319@ 
ESOL32¢0 
ESOL32106 
ESOL3226 
ESOL323@ 
ESOL324@ 
ESOL325@ 
ESOL3260@ 
ESOL327@ 
ESOL3280@ 
ESOL3296 
ESOL330@ 
ESOL3316 
ESOL332@ 
ESOL333@ 
ESOL334@ 
ESOL335@ 
ESOL3360@ 
ESOL337@ 
ESOL3380 
ESOL339@ 
ESOL34@@ 
ESOL341@ 
ESOL3420@ 
ESOL3430 
ESOL3446 
ESOL3456 
ESOL3460@ 
ESOL3470@ 
ESOL3480 
ESOL349@ 
ESOL35@@ 
ESOL351@ 
ESOL3520 
ESOL3530@ 
ESOL354@ 
ESOL3550@ 
ESOL356@ 
ESOL3570@ 
ESOL3580@ 
ESOL359@ 
ESOL360@ 
ESOL3616 
ESOL36 20 
ESOL3630@ 
ESOL364@ 
ESOL365@ 
ESOL366@ 
ESOL3670@ 
ESOL 3680 
ESOL3690@ 
ESOL37@@ 
ESOL371@ 
ESOL372@ 
ESOL3730@ 
ESOL374@ 
ESOL375@ 
ESOL3760 
ESOL377@ 


CONT INUEESOL3780@ 


GOTO 44 


ESOL3790 
ESOL380@ 
ESOL381@ 
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43 


an 


AagQIaAaAaNRaaanannannanann 


OD 
IF (NS 


DO 43 I=1,N 
Y(ITER,I,J) = 9 
oD 


ING.NE.@) DMOD = @ 


*& 


END MSOLVE *XXXRRKAARKRAKKAARKAARRRKRERKRRK RK KKRRRR ARERR 


PROCEDURE MIXED~RADIX ®XXXAKAKAKKARERRERRARKRKRAKEREEEA 


THIS PROCEDURE COMPUTES THE ITER'TH TERMS OF THE 
MIXED-RADIX REPRESENTATION OF ¥( ,N,M) AND DET 
USING THE CHINESE REMAINDER THEOREM. 


TEST IS TRUE ONLY IF THE ITER'TH TERMS OF THE 
MIXED-RADIX REPRESENTATIONS OF DET AND Y ARE 


ALL ZE 


NOTE: IN FORTRAN, THE EVALUATION B=MOD(A,P) YEILDS 
AN INTEGER B SUCH THAT ~P¢B¢cP. IN THIS PROCEDURE, 
ANY SUCH B IS CONVERTED TO A SYMMETRIC RESIDUE C, 
-P¢2C¢P VIA THE EVALUATION C=B-(B/P2)*P. 


TEST = 
ITER1 
ITER2 
DO 52 
DO 


OD 
oD 
IF (IT 


THEN 
MUL 


ELSE 
MUL 
IF 


RO. 


.TRUE. 

ITER - 1 
ITER - 2 
I=1,N 

52 J=1,M 

IF (ITER.EQ.1) 


THEN 
MULT = Y(ITER,I,J) 


ELSE 
MULT = Y(ITERI,I,J) 
IF (ITER.NE.2) 


THEN 
DO 48 LL=1,ITER2 
L = ITER] - LL 


MULT = MOD (MULT*PRIME(L)+Y(L,1,J),P) 


oD 


MULT = MOD(IP * MOD(Y(ITER,I,J)-MULT,P) ,P) 
YC(ITER,1I,J) = MULT - (MULT/P2)*P 


IF (TEST) 


THEN 
IF (Y(ITER,I,J).NE.@) TEST = .FAUSE. 


ER.EQ.1) 


T = DMOD 


T = DET(ITER1) 
(ITER.NE.2) 


THEN 


DO 56 LL=1,ITER2 


L = ITER] - LL 


MULT = MOD(MULT*PRIME(L) + DET(L),P) 
oD 
MULT = MOD(IP * MOD(DMOD-MULT,P), P) 
DET(ITER) = MULT - (MULT/P2)*P 
IF (DET(ITER).NE.6) TEST = .FALSE. 


eee eee He HF HF HH He 


* 


END MIXED-RADIX ®XAKAAKAKKAARKKKARAKARRRERRRRER KER ARR EK 


IF (TEST) 


THEN 
NOZERO 


ELSE 


= NOZERO + 1 


GOTO 45 
GOTO 46 


GOTO 5¢ 


GOTO 47 
GOTO 49 


GOTO 51 
GOTO 52 


ESOL382@ 
ESOL383@ 
ESOL384@ 
ESOL385@ 
ESOL386¢@ 
ESOL387@ 
ESOL3880 
ESOL389@ 
ESOL39(@ 
ESOL391@ 
ESOL392¢ 
ESOL393@ 
ESOL39406 
ESOL3950@ 
ESOL396@ 
ESOL397@ 
ESOL398¢@ 
ESOL3990 
ESOL40600 
ESOL4010@ 
ESOL4620 
ESOL4030 
ESOL4G646 
ESOL4@50@ 
ESOL4660 
ESOL4067@ 
ESOL4@80 
ESOL4069¢@ 
ESOL416¢ 
ESOL411¢ 
ESOL412¢ 
ESOL413@ 
ESOL414@ 
ESOL415@ 
ESOL416¢ 
ESOL417@ 
ESOL418¢ 
ESOL419@ 
ESOL42¢¢ 
ESOL421@ 
ESOL422@ 
ESOL423¢ 
ESOL424@ 
ESOL425@ 
ESOL426@ 
ESOL4270@ 
ESOL428¢@ 


CONTINUEESOL429@ 


GOTO 53 
GOTO 54 


GOTO 58 


GOTO 55 
GOTO 57 


GOTO 59 
GOTO 6¢ 


GOTO 61 


ESOL4300 
ESOL431@ 
ESOL432@ 
ESOL433@ 
ESOL4340 
ESOL435@ 
ESOL4360@ 
ESOL437@ 
ESOL438@ 
ESOL4390 
ESOL440¢@ 
ESOL44106 
ESOL442@ 
ESOL443¢ 
ESOL4446 
ESOL4456 
ESOL44606 
ESOL4470@ 
ESOL448@ 
ESOL449@ 
ESOL4500 
ESOL4510 
ESOL452@ 
ESOL4530@ 
ESOL454@ 
ESOL455@ 
ESOL4560@ 
ESOL4570@ 
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60 NOZERO = @ ESOL4580 
61 IF (RTEST .AND. ITER.GT.NOZERO .AND. NOZERO.GE.TR) GOTO 62 ESOL459¢ 
GOTO 64 ESOL4606¢ 
Cc THEN ... NORMAL EXIT; FIRST, HOWEVER CHECK FOR ZERO ESOL461@ 
C ... DETERMINANT. ESOL4620 
62 IER = @ ESOL4630@ 
NOCOEF = ITER - NOZERO ESOL4640 
DO 63 K=1,NOCOEF ESOL465¢ 
IF (DET(K).NE.@) RETURN ESOL466@ 
Cc OD ESOL467@ 
63 CONTINUEESOL468@ 
IER = 2 ESOL469@ 
RETURN ESOL470@ 
64 CONTINUE ESOL471¢ 
c ESOL472¢ 
c **MAXPRM COEFFICIENTS HAVE BEEN USED, ADNORMAL EXIT. ESOL4730@ 
C ESOL474@ 
NOCOEF = MAXPRM - NOZERO ESOL475¢@ 
IER = 1 ESOL4760 
IF (NOCOEF.EQ.@) IER = 3 ESOL477@ 
RETURN ESOL4780@ 
END ESOL4790@ 
BLOCK DATA DATAGO1O 
Cc DATAQO20 
CRERKKKKKKEKEKERKRKRERKERKKEKKKEREKEREREKEAKEKKKEKEKREKAEKKKEEKKKKK DATAGG30 
Cc x DATAGA4D 
C HAEKKAWARNINGRARKR * DATAQO56 
Cc * DATAGOGEG 
C ARRAY NAMES ARE USED IN THE DATA STATEMENTS BELOW TO * DATAOO7O 
C SPECIFY VALUES FOR THE ARRAYS KPRIME AND IPRIME. IN SOME * DATAQGO8O 
C INSTALLATION IT MAY BE NECESSARY TO EXPLICITLY LIST THE * DATAGOIG 
C COMPONENTS OF THE ARRAYS, NAMELY, KPRIME(E), KPRIME(2),...,  * DATAQI OA 
C KPRIME(19@@) AND JPRIME(1), IPRIME(2),...,1PRIME( IQ). x DATAQI1@ 
Cc x DATAO1 20 
CHEKKKKKEKKEKKEKEKKEKEEKRERKEKKEKREREKEKRERERAKKRKKKKKEKKRKKEKKEKEKKKK DATAQ@13@ 
Cc DATAQ14@ 
COMMON /PRIMEB/KPRIME (1060) , [PRIME (190) DATAO15@ 
DATA KPRIME/ 45233,45247, 45259, 45263, 45281, 45289 DATAGLOO 
1,45293,45307,45317,45319, 45329, 45337, 45341, 45343, 45361 DATAQL7@ 
2,45377, 45389, 45463, 45413,45427,45433,45439 45481, 45491 DATAGO18@ 
3,45497 45503, 45523, 45533, 45541, 45553, 45557,45569, 45587 DATAQG1L9@ 
4,45589, 45599, 45613, 45631, 45641, 45659 ,45667,45673,45677 DATAQ200 
5,45691, 45697, 45707, 45737,45751,45757, 45763, 45767,45779 DATAQ210 
6,45817, 45821, 45823, 45827, 45833, 45841, 45853, 45863, 45869 DATAQ220 
7,45887,45893, 45943, 45949, 45953,45959 45971, 45979 , 45989 DATAQ2 30 
8, 46021 ,46027, 46049, 46051, 46661, 46073, 46091 , 46993, 46099 DATAQOL4S 
9, 46103, 46133, 46141,46147, 46153, 46171, 46181, 46183, 46187 DATAQ250 
X, 46199, 46219, 46229, 46237, 46261, 46271, 46273, 46279, 46301 DATA@260 
Y , 46307, 46309, 46327, 46337/ DATAQ2706 
DATA IPRIME/ 90006, 42015,28577,01168,29342,16641 DATAO28¢ 
1,10405, 19447, 26685, 39525, 14116,12753,32178,01043,08857 DATAG290 
2,27911,15049,067679, 33425, 0O804 , 23175, 23886,44779 41942 DATAG30@ 
3,10171, 16606,10638,17371, 27195, 35827, 42639, 01829, 24658 DATAO310 
4,99023, 37958, 39638, 06339, 412706, 40538, 10157,11783,00457 DATAQ320 
5, 32947, 42170, 17910, 33474, 20017, 25086, 36508, 37444, 35543 DATAQO3 30 
6, 96993, 10326, 16328, 26765, 42083, 37223, 30711, 09408, 06635 DATAQO340 
7, 38421, 11397, 32683, 17333, 34245, 15748, 35735, 23492, 19302 DATAQ35@ 
8, 20076, 45620, 44978, 09864, 14832, 16092,19457,24045,44950 DATAG360 
9, 32872, 24309,15726,43057,37766, 14946, 41826, 19946,41363 DATAQ37@ 
X,23967,39791, 29237, 18085, 12952, 36850,62213, 30023, 34871 DATAG38@ 
Y,42667, 46410, 32615, 46136/ DATAO39@ 
END DATAO406 
SUBROUTINE SUBBND(A,B,GAMMA,DELTA,S,SUM,T,N,M,NM, SBNDOO1@ 
1 TWOT1, BOUND , NO) SBNDQO20 
Cc SBNDGO30 
CREAKRKKRKKKKKEKEKKKRAKKEKKAERKEKEKKERERER EK KRRAKERRERERERRERKRKEKKRKKKKKEK SBNDGO4O 
Cc k SBNDQO5O 
C USING HADAMARD'S INEQUALITY, THIS SUBROUTINE COMPUTES THE * SBNDQOO6A 
C MAXIMUM NUMBER OF PRIMES REQUIRED TO REPRESENT DETERMINANT (A)* SBNDGO70 
C AND A(ADJOINT)*B FOR THE SYSTEM OF LINEAR EQUATIONS AX=B, x SBNDGO8O 
C WHERE A( ,N,N) AND B( ,N,M) ARE MATRICES WITH MULTIPLE- * SENDOGIO 
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PRECISION INTEGER COEFFICIENTS EXPRESSED IN MIXED-RADIX FORM.* 


PRIME 
(INPUT) 


A 
(INPUT) 


C 

Cc 

C 

C 

C 

Cc 

C 

C 

C 

C 

C 

C 

C 

Cc 

Cc 

C 

Cc 

C 

C 

C 

Cc B 
C (INPUT) 
C DELTA 
C (TEMP) 
C 

Cc 

C GAMMA 
C (TEMP) 
C 
C 
C 
C 
C 
C 
Cc 
C 
Cc 
C 
Cc 
C 
Cc 
Cc 
C 
Cc 
Cc 
Cc 
C 


(1NPUT) 


N 
(INPUT) 


M 
(INPUT) 


NM 
C (INPUT) 
C TWOTL 

C (INPUT) 
C NO 

C (OUTPUT) 
C 

C 

C 

C BOUND 
C(OUTPUT) 
C 


* 


IS A LINEAR ARRAY CONTAINING 166 DISTINCT PRIME * 
INTEGERS IN ASCENDING ORDER. THESE PRIMES ARE THE x 
RADII USED IN THE REPRESENTATION OF A AND B AND OF x 
DETERMINANT(A) AND A(ADJOINT)*B.THE PRIMES ARE CHOSEN* 
AS LARGE AS POSSIBLE SUBJECT TO THE CONDITION THAT 
FOR ALL I AND J PRIME(I)*PRIME(J) DOES NOT OVERFLOW 
AN INTEGER WORD. 
IS AN INTEGER MATRIX OF DIMENSION T BY N BY N. THE 
FIRST DIMENSION CONTAINS THE COEFFICIENTS OF THE 
MIXED-RADIX REPRESENTATION OF THE MULTIPLE-PRECISION 
COMPONENTS OF THE N BY N MATRIX AC ,N,N). THAT IS, 

AC ,1I,J) = A(1,1,J) 

+ A(2,1,J)*PRIME(1) 


+. 


A(T,1,J)*PRIME(1)*...*PRIME(T-1), 

FOR I,J=1,2,...,N. 

IS AN INTEGER MATRIX OF DIMENSION T BY N BY M WITH 

A SIMILAR NOTATIONAL CORRESPONDENCE MADE FOR A ABOVE. 
IS AN INTEGER ARRAY OF DIMENSION TWOT1 USED TO STORE 
THE COEFFICIENTS OF THE MULTIPLE-PRECISION INTEGERS 
A( ,1,J3)**2 AND B( ,I,J)**2 FOR ANY PARTICULAR 

AC ,I,J) OR BC ,I,J). 

IS AN INTEGER ARRAY OF DIMENSION TWOTL USED TO STORE 
THE COEFFICIENTS OF THE MULTIPLE-PRECISION PARTIAL 
PRODUCTS OBTAINED WHEN A( ,1I,J)**2 OR B( ,I,J)**2 ARE* 
BEING COMPUTED. * 
IS AN INTEGER ARRAY OF DIMENSION TWOT] USED TO STORE * 
THE SUM OF (A( ,I,J)**2, I=l,...,N) OR THE SUM OF * 
(BC ,I,J)**2 ,I=1,...,N) FOR ANY PARTICULAR COLUMN J.* 
IS A REAL ARRAY OF DIMENSION NM. FOR 1<=J<=N, S(J)  * 
CONTAINS A BOUND FOR THE LOGARITHM OF SUM(A( ,I,J)**2* 
,T=1,-..,N) AND FOR N+I<=J-=NM OF SUM(BC I,J) **2, 
cg eee gee 

IS ‘THE NUMBER OF RADIL, PRIME(L),...,PRIME(T), USED 
TO REPRESENT EACH COMPONENT OF AC ,N,N) AND BC ,N,M) 
IN MIXED-RADIX FORM. 

IS THE NUMBER OF EQUATIONS AND THE NUMBER OF UNKNOWNS* 
IN THE SYSTEM. (I.E., N IS THE SIZE OF THE SECOND 
AND THIRD DIMENSIONS OF A.) 

IS THE NUMBER OF RIGHT-HAND VECTORS FOR WHICH THE 
SYSTEM IS TO BE SOLVED. (I.E., M IS THE SIZE OF THE 
THIRD DIMENSION OF B.) 

IS EQUAL TO N+M. 


+e ee HF Fe ee EO EH EH HH Oe 


+ 


+ ee > 


IS EQUAL TO 2*T+l1. 


+e +e ee HE OF F 


IS A BOUND FOR THE NUMBER OF PRIMES REQUIRED TO SOLVE* 


THE SYSTEM OF LINEAR EQUATIONS AX=B. THAT IS, NO IS * 
A BOUND FOR THE NUMBER OF PRIMES REQUIRED TO * 
REPRESENT DETERMINANT(A) AND A(ADJOINT)*B IN MIXED- * 
RADIX FORM. * 
IS EQUAL TO THE LOGARITHM OF THE PRODUCT OF THE FIRST* 
NO PRIMES. * 


* 


CHARKAKKEKAKEKRKKERKRKERKER ERE REKKER KERR ERA RERERERERERERKEKEKEREKKKKK 


C 


INTEGER T,TWOT,TWOT1L,A(T,N,N),B(T,N,M) ,DELTA(TWOTL), 


l 


GAMMA (TWOT1) , PRIME(10@) ,SUM(TWOT1) ,CSUM,Q, PD 


REAL S (NM) 

INTEGER TK,TK1 

COMMON /PRIMEB/ PRIME, IPRIME(19@) 
TWOT = 2*T 


aaaan\»anana 


PROCEDURE ABOUND#&XX&XKAAKAARKKAKARRR ER AKREREKERRERRRE RRR 


FOR EACH J, l¢=Je=N, THE SUM OF THE SQUARES OF THE 
ELEMENTS IN THE J-TH COLUMN OF A IS COMPUTED. THE 
SUM, WHICH IS A MIXED-RADIX, MULTIPLE-PRECISION 
INTEGER OF LENGTH AT MOST 2*T+1, IS STORED IN THE 
VECTOR SUM. THE LOGARITHM OF A BOUND FOR THE SUM IS 
THEN COMPUTED AND STORED IN S(J). 


eee Ee EF 


DO 16 J=1,N 
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SBNDO14¢ 
SBNDO11O 
SBNDO12¢ 
SBNDOL30 
SBNDO1L4@ 
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SBNDO19¢ 
SBNDO206¢ 
SBNDG21¢ 
SBNDO226 
SBNDO23¢ 
SBND@249 
SBNDO250 
SBNDO26¢ 
SBNDO270 
SBNDO280 
SBNDO290 
SBNDO3¢0 
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SBNDG32¢ 
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SBNDG34¢ 
SBNDO35¢ 
SBNDO360 
SBNDG370@ 
SBNDO380 
SBNDO390@ 
SBNDG40¢ 
SBNDO410 
SBNDG42¢ 
SBNDO430 
SBNDO446 
SBNDO45¢@ 
SBNDAAOP 
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SBNDO52¢ 
SBNDO530 
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SBND@590 
SBNDG640 
SBNDQ61¢ 
SBNDG6 20 
SBNDG63¢ 
SBNDG640 
SBND@650 
SBNDO660 
SBNDG67¢ 
SBNDG680 
SBNDG69¢ 
SBNDO70¢ 
SBNDG710 
SBNDQ72¢ 


SBND 73¢ 
SBNDQ740 
SBNDO75@ 
SBNDO760 
SBNDQ@77@ 
SBNDQ78¢ 
SBNDO79@ 
SBNDO8O¢ 
SBNDO81¢ 
SBNDG826 
SBNDG830 


0 


COLLECTED ALGORITHMS (cont.) 


aaAaaNAN 


aan 


AAAARAANA 


aa AQAA 


**COMPUTE LOG (BOUND FOR (SUM OF A( ,1I,J)**2, 
*kT=1,...,N)), AND STORE THE RESULTS IN S(J). 
DO 1 K=1,TWOTL 

SUM(K) = @ 
op 
DO 9 I=1,N 


PROCEDURE SQUAREX###X#44KKRAKAKRKRRRRRRERERRRRRER 
AC ,1,J)**2 IS COMPUTED. THE COEFFICIENTS OF * 


THE MIXED—RADIX, MULTIPLE-PRECISION RESULT 


ARE STORED IN DELTA. 
DO 2 II=1,TWOT1 


DELTA(II) = @ 
GAMMA(II) = @ 


REPEAT 
IF (K.LE.L) 


THEN 


**COMPUTE PARTIAL PRODUCT AND STORE IN 


**GAMMA . 
Q=o | 
TK = T-K 
pO 5 II=1,T 
PD = A(TK,I,J)*A(II,1I,J) + Q 
Q = PD/PRIME(II) 
GAMMA(II) = PD - Q*PRIME(II) 
oD 
GAMMA(T+1) = Q 
**ADD PARTIAL PRODUCT TO DELTA. 
Q=¢6 
Ll = THK 
TKI = T+K+1 
DO 6 II=1,L1 


PD = PRIME(TK)*DELTA(II) + GAMMA(TI) 


+ Q 
Q = PD/PRIME(II) 
DELTA(II) = PD - Q*PRIME(II) 
oD 
DELTA(TK1) = Q 
K = K+l 


CONTINUE 


* 


* 
* 


GOTO 4 
GOTO 7 


GOTO 3 


* 


END SQUARE®#&44AKKAAAAKKKRAKERKAKKERRRER RARER RR 


*KACCUMULATE THE SUM OF A( ,1,J)**2. 
Q= 6 
DO 8 II=1,TWOT1] 
CSUM = DELTA(II)+SUM(II)+Q 
Q = CSUM/PRIME(II) 
SUM(II) = CSUM - Q*PRIME(IT) 
oD 
OD 


**CALCULATE ABOUND FOR THE MULTIPLE-PRECISION 
**kINTEGER IN SUM AND STORE THE LOG OF THIS 
**BOUND IN S(J). 
K = TWOT1 
REPEAT...FIND OUT THE LENGTH K OF THE MULTIPLE- 
. «PRECISION NUMBER IN SUM. 
IF (K.GT.1.AND.SUM(K) .EQ.0) 


THEN 
K=K-1 


CONTINUE 
S(J) = 0.0 
IF (K.GT.1) 


SBND@840 
SBND@85@ 
SBNDG860 
SBNDO87@ 
SBNDG886 
SBNDG890@ 
SBNDOIGO 
SBNDG916 
SBNDO920 
SBNDO93@ 
SBNDO94G 
SBNDG95¢ 
SBNDG960 
SBNDO97@ 
SBNDO98@ 
SBNDG99@ 
SBND1¢00 
SBND1¢1@ 
SBND1¢20 
SBND1063¢ 
SBND104¢ 
SBND105@ 
SBND196@ 
SBND1067¢ 
SBND1@8@ 
SBND109¢ 
SBND1106¢ 
SBND111¢ 
SBND112@ 
SBND113@ 
SBND114@ 
SBND115@ 
SBND116@ 
SBND117@ 
SBND118¢ 
SBND119@ 
SBND 12060 
SBND1216 
SBND122¢ 
SBND123@ 
SBND124@ 
SBND125@ 
SBND126¢ 
SBND127¢@ 
SBND128¢@ 
SBND129@ 
SBND1300 
SBND131@ 
SBND132@ 
SBND133¢ 
SBND134@ 
SBND135@ 
SBND136@ 
SBND1370 
SBND138@ 
SBND139@ 
SBND14060 
SBND141@ 


CONTINUESBND142@ 


GOTO 
GOTO 


GOTO 


GOTO 
GOTO 


11 
12 


19 


13 
15 


SBND143@ 
SBND144@ 
SBND145@ 
SBND146¢@ 
SBND147¢ 
SBND148¢ 
SBND149@ 
SBND1L56@ 
SBND151¢ 
SBND152@ 
SBND153@ 
SBND154@ 
SBND155@ 
SBND1560@ 
SBND1570 
SBND158@ 
SBND159¢ 
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COLLECTED ALGORITHMS (cont.) 


Cc 


io) 


aQ 


AMARAAQAAANANARAANANAANAAA 


13 


14 


pa 
wm 


_ 
ON 


17 


18 


21 


22 


THEN 
L = K-1 
DO 14 II=1,L 
S(J) = S(J) +ALOG(FLOAT (PRIME(II))) 
0))) 


S(J) = S(J)+ALOG (FLOAT (SUM(K)+1) ) 


ELSE 
IF (SUM(K) .GT.@) S(J) = ALOG(FLOAT(SUM(K))) 
OD 


* 


END ABOUNDEXA&AKERAEAKAKAKRKAKKERARRAR AK RRARAKERERRERE RARER 


PROCEDURE BBOUND#X&XRAKKARAAKAAKRARKAR KARR AK RKRAERERRRERRER 


FOR EACH J, l¢=J¢=M, TEE SUM OF THE SQUARES OF THE 
ELEMENTS IN THE J-TH COLUMN OF B IS COMPUTED. THE 
SUM, WHICH IS A MIXED-RADIX, MULTIPLE PRECISION 
INTEGER OF LENGTH AT MOST 2*T+1, IS STORED IN THE 
VECTOR SUM. THE LOGARITHM OF A BOUND FOR THE SUM IS 
THEN COMPUTED AND STORED IN S(N+J). 


NOTE: THE COMPUTATIONAL PROCEDURE IS THE SAME AS FOR 
A ABOVE. 


DO 32 J=1,M 
DO 17 K=1,TWOT1 
SUM(K) = @ 
(0))) 
DO 25 I=1,N 
DO 18 II=1,TWOT1 
DELTA(II) = @ 
GAMMA(II) = @ 
oD 
Q=¢ 
K=@ 
L = T-l 
REPEAT 
IF (K.LE.L) 


THEN 
Q=¢ 
TK = T-K 
DO 21 II=1,T 
PD = B(TK,1I,J)*B(II,I,J) + Q 
Q = PD/PRIME(II) 
GAMMA(II) = PD - Q*PRIME(II) 
oD 
GAMMA(T+1) = Q 
Q=¢ 
Ll = T+K 
TKI = T+K+1 
DO 22 II=1,L1 
PD = PRIME(TK)*DELTA(IL) + GAMMA(II)+Q 
Q = PD/PRIME(II) 
DELTA(II) = PD - Q*PRIME(II) 
OD 
DELTA(TK1) = Q 
K = K+l 


CONTINUE 

Q=9 

DO 24 II=1,TWOT1 
CSUM = DELTA(II)+SUM(II)+Q 
Q = CSUM/PRIME(II) 
SUM(II) = CSUM - Q*PRIME(II) 


oD 
oD 
K = TWOTL 
REPEAT 
IF (K.CT.1.AND.SUM(K) .EQ.@) 
THEN 
K=k-1 


i i ee 


SBND160¢ 
SBND161¢ 
SBND162¢ 
SBND163@ 
SBND164@ 
SBND165¢ 
GOTO 16 SBND166@ 
SBND167@ 
SBND168@ 
SBND169@ 
CONTINUESBND17@ 
SBND171@ 
SBND172¢ 
SBND173¢ 
SBND174@ 
SBND175¢ 
SBND176¢ 
SBND177@ 
SBND178@ 
SBND179¢ 
SBND18¢6¢ 
SBND181¢ 
SBND182¢ 
SBND183@ 
SBND184@ 
SBND185¢ 
SBND186¢ 
SBND187@ 
SBND188¢ 
SBND189¢ 
SBND19¢6@ 
SBND191¢ 
SBND192¢ 
SBND193¢ 
SBND194@ 
SBND195@ 
SBND196@ 
SBND197@ 
SBND198¢ 
GOTO 2@ SBND199¢ 
GOTO 23 SBND20060 
SBND2¢1¢ 
SBND202¢ 
SBND2063¢ 
SBND204¢ 
SBND2065¢ 
SBND296@ 
SBND207¢ 
SBND2080 
SBND209¢ 
SBND216¢ 
SBND2110@ 
SBND212¢ 
SBND213@ 
SBND214@ 
SBND215@ 
SBND216@ 
SBND217@ 
SBND218¢ 
SBND219¢ 
GOTO 19 SBND22¢6¢ 
SBND221¢ 
SBND222¢ 
SBND223¢ 
SBND224¢ 
SBND225@ 
SBND226¢ 
SBND227@ 
SBND228¢ 
CONTINUESBND229@ 
SBND 2300 
SBND231¢@ 
GOTO 27 SBND232@ 
GOTO 28 SBND233@ 
SBND234¢ 
SBND235@ 
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COLLECTED ALGORITHMS (cont.) 


GOTO 26 SBND236¢ 

Cc CONTINUE SBND237@ 
28 NJ = N+J SBND238@ 
S(NJ) = @.0 SBND239@ 

IF (K.GT.1) GOTO 29 SBND24¢6¢ 

GOTO 31 SBND241¢ 

Cc THEN SBND242@ 
29 L = K-l SBND2430 
DO 3¢ II=1,L SBND244@ 

3¢ S(NJ) = S(NJ) +ALOG(FLOAT(PRIME(IT))) SBND245@ 
Cc OD SBND246@ 
S(NJ) = S(NJ)+ALOG (FLOAT (SUM(K)+1)) SBND247@ 

GOTO 32 SBND248¢ 

Cc ELSE SBND249@ 
31 IF (SUM(K).GT.@) S(J) = ALOG(FLOAT(SUM(K))) SBND2500 
€ OD SBND2510 
32 CONE NURS D2 33e 
Cc SBND253@ 
Cc END sain cs ial tesa van nud dated una da pana asanauMeekaaieas SBND254@ 
C SBND255@ 
Cc SBND256¢ 
Cc **FIND MIN(S(I)), 1 =1,...,N. SBND2570@ 
SMIN = $(1) SBND 2580 

DO 33 I=1,N SBND2590 

33 IF (SMIN. GT.S(I)) SMIN = S(I) SBND2600 
Cc OD SBND261¢ 
C *KFIND MAX(S(I)), I=N+l,...,NM. SBND262¢ 
SMAX = S(N+1) SBND263@ 

= N+l SBND264¢ 

DO 34 I=L,NM SBND265¢ 

34 IF (SMAX.LT.S(I)) SMAX = S(T) SBND266@ 
c oD SBND267@ 
Cc **IF SMIN k= SMAX, THEN BOUND = (SUM OF S(I))/2+ LOG(2.0) SBND268@ 
Cc **ELSE BOUND = ((SUM OF S(1))+SMAX-SMIN) /2+L0G(2.@), SBND269¢ 
Cc **WHERE THE SUM IS TAKEN OVER I=1,...,N. SBND2706@ 
BOUND = @.@ SBND2710@ 

DO 35 I=1,N SBND272@ 

35 BOUND = BOUND+S (I) SBND273@ 
Cc OD SBND274@ 
IF (SMIN.GE.SMAX) GOTO 36 SBND275¢ 

GOTO 37 SBND276¢ 

Cc THEN SBND277@ 
36 BOUND = BOUND/2.@ + ALOG(2.@) SBND278@ 
GOTO 38 SBND279¢ 

Cc ELSE SBND 2800 
37 BOUND = (BOUND+SMAX-SMIN)/2.@ + ALOG(2.@) SBND281¢ 
Cc **kCALCULATE NUMBER OF PRIMES REQUIRED. SBND282¢ 
38 NO = @ SBND283¢@ 
SUMLOG = @.¢@ SBND284¢ 

Cc REPEAT SBND285@ 
39 NO = NO+t1 SBND286¢@ 
IF (SUMLOG.GE.BOUND) GOTO 46 SBND287@ 

Cc THEN SBND2880 
Cc re EXIT SBND289¢@ 
SUMLOG = SUMLOG + ALOG(FLOAT (PRIME (NO) )) SBND290¢ 

GOTO 39 SBND291¢ 

Cc CONTINUE SBND 2926 
4@ RETURN SBND293¢@ 
END SBND294@ 
SUBROUTINE MRADIX(A,N,C,LMAX,L,B, IER) MRADOO10 

Cc MRADOO20 
CHERKKRKKKKKEAAKAAKRKKKEEKRKKKRKKKEEKERARKKRKRRREERERKKKEKREKREREREREREEAKEKK MRADOO30 
C GIVEN THE FIXED-RADIX INTEGER x MRADOO40 
Cc * MRADOO50 
C  AC(1)*B**(N-1) + 2... + ACN-1)*B + A(N), * MRADOG6O 
Cc * MRADOO7@ 
C WHERE ABS(A(I)) < B, I=#l,...,N, MRADOO80 
C THIS SUBROUTINE COMPUTES (FOR SOME L <= LMAX) THE CORFFICTENTSA MRADOO9IO 
C C(1),C(2),...,C(L) IN ITS SYMMETRIC MIXED-RADIX MRADO100 
C REPRESENTATION: rs MRADO110 
Cc * MRADQ12¢ 
C  C(1)+C(2)*P(1) + ... + CCL)*P(1)*P(2)*...*P(L=1). * MRADG130 
C * MRADO14@ 
C LMAX MUST BE GIVEN SUCH THAT * MRAD@150 
Cc * MRAD@16¢@ 
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COLLECTED ALGORITHMS (cont.) 


aan 


aaa 


Cc 


ANQANQADAANDANAANNAAAANDND 


LMAX >= (N * LOG B + LOG 2) / LOG(P(1)). 


IER IS AN ERROR CODE WHICH IS 1 IF THE DIMENSION PARAMETER N, 
LMAX ARE INCORRECT, AND @ OTHERWISE. 


RARKKKK WARNING *tAdAK 


THIS SUBROUTINE ASSUMMES THAT FOR ALL I,J 
P(I)*P(J) AND P(I)*B 
DO NOT OVERFLOW A COMPUTER WORD. 


RKKKKKEKKKERKERKEREEKKEKKREREKEKRERERERREKEKREREREEKKKAKKKKKKKKK 


INTEGER A(N) ,C(LMAX) ,P (10) ,Q,QTEMP,PP,B,P1 
COMMON /PRIMEB/ P, IPRIME(10@) 

IER = 1 

IF (N.LT.1 .OR. LMAX.LT.1) RETURN 

i= 1 

c(1) = @ 

DO 4 I=1,N 


*KAT THIS STAGE C(1)+C(2)*P(1)+...4C(L)*P(1)*P(2)*.. .* 


*kP(L-1) IS THE MIXED-RADIX REPRESENTATION OF 
*KA (1) *B** (1-2) +A (2) *B** (I-3)+...4+A(I-1). 
Q = A(T) 
pO 1 J=1,L 
**COMPUTE THE FIRST L COEFFICIENTS OF THE MIXED- 
**RADIX REPRESENTATION OF A(L)+B*(C(1)+C(2)*P(1)+ 
*K,. .+C(L)*P(1)*P(2)*...*P(L-1)). 
PP = P(J) 
QTEMP = Q + B*C(J) 
Q = QTEMP/PP 
C(J) = QTEMP - Q*PP 
OD 
REPEAT ... 
wee P(2)*%...*P(L-1)+Q*P (1)*...*P (L) 
... TO MIXED-RADIX FORM. 
IF (Q .NE.Q) 


CONVERT C(1)+C(2)*P(1)+...4+C(L)*P(1)* 


THEN 
L = L+l 
IF (L.GT.LMAX) RETURN 
PP = P(L) 
QTEMP = Q/PP 
C(L) = Q - QTEMP*PP 
Q = QTEMP 


CONTINUE 
OD 


**CONVERT TO SYMMETRIC MIXED-RADIX FORM. 
Q= o 
DO 5 I=1,L 
C(I) = C(1I)+Q 
Pl = (P(I)+1)/2 
Q = C(1)/P1 
C(I) = CCI) - Q*P(I) 
oD 
IF (Q.NE.@) 


THEN 
L = Lt 
IF (L.GT.LMAX) RETURN 
C(L) = Q 
IER = @ 
RETURN 
END 


SUBROUTINE FRADIX(C,N,A,LMAX,L,B, IER) 


* 
x 
* 
* 
x 
* 
* 
* 
* 
* 
* 
* 
* 
* 


GOTO 3 
GOTO 4 


GOTO 2 


MRADQ17¢ 
MRADO18¢ 
MRADQ19@ 
MRADQ200 
MRADO210 
MRADO22¢ 
MRADO23¢ 
MRADO240 
MRADO25@ 
MRADG26¢ 
MRADQ270 
MRADO28¢ 
MRADG29¢@ 
MRADO300 
MRADO310 
MRADO326 
MRAD 33¢ 
MRAD@340 
MRADO35@ 
MRADG36¢ 
MRAD@37¢@ 
MRADO38¢ 
MRADQO396 
MRADO400 
MRADQG410 
MRADG42¢ 
MRADG43¢ 
MRADG44@ 
MRAD@45@ 
MRADO46@ 
MRADO47@ 
MRAD@48¢ 
MRADO49¢@ 
MRADG500 
MRAD@51¢ 
MRADO52¢ 
MRADO53¢ 
MRAD@540 
MRADG55@ 
MRAD@56¢ 
MRADQO57@ 
MRADG58¢@ 
MRAD@59@ 
MRADG600 
MRADG61¢ 
MRADG62¢ 
MRAD@63¢ 
MRAD@64@ 
MRADG65¢ 
MRADG660 


CONTINUEMRAD@6 70 


GOTO 6 
GOTO 7 


CHRKAAKERERRERERERREKRERREREREEREREREREREKARRERERKEERERERAREREREERER 
C GIVEN THE MIXED-RADIX INTEGER 


Cc 
Cc 


C(1)4+C(2)*P(1)+ ... 


+C(N)*P(1)*...*P(N-1), 


* 


* 
* 


MRADG68¢ 
MRADG690 
MRADQ700 
MRADQ710 
MRADQ72¢ 
MRADO73¢ 
MRADO74@ 
MRADG75@ 
MRADQO760 
MRADO770 
MRADG78¢@ 
MRADQ79@ 
MRAD@&8OO 
MRADG81¢ 
MRADO82¢ 
MRADG83¢ 
MRADO84@ 


FRADOG1¢ 
FRADQO2¢ 
FRADGO30 
FRADOO40 
FRADOO5@ 
FRADGG66 
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Cc * FRADOQ70 
C WHERE ABS(C(I)) < (P(I)+1)/2, I=l,...,N, * FRADGO80 
C THIS SUBROUTINE COMPUTES(FOR SOME L <= LMAX) THE COEFFICIENTS* FRADOG9@ 
C A(1),A(2),...,A(L) IN ITS FIXED-RADIX REPRESENTATION: * FRADO100 
Cc * FRADG11¢ 
C AC 1) *B** (L-1)+A(2)*B*(L-2)+...+A(L), * FRAD@12@ 
Cc ® FRADQ13@ 
C WHERE ABS(A(I)) < B. * FRADQ@14¢ 
Cc * FRADQL5@ 
C LMAX MUST BE GIVEN SUCH THAT * FRADG16@ 
c * FRADG17¢ 
C LMAX >» (N*LOG(P(N)) - LOG 2) / LOG B. * FRADO18¢ 
Cc * FRADG19¢ 
C IER IS AN ERROR CODE WHICH IS 1 IF THE DIMENSION PARAMETER N,* FRADQ2060 
C LMAX ARE INCORRECT, AND @ OTHERWISE. * FRADG210 
c * FRADO22@ 
C REKAKKK WARNING k&kAKKKK * FRADG23¢@ 
Cc * FRADG24@ 
C THIS SUBROUTINE ASSUMMES THAT FOR ALL I * FRAD@25@ 
c * FRAD@26@ 
Cc P(I)*B * FRADQ27@ 
Cc x FRADO28¢ 
C DOES NOT OVERFLOW A COMPUTER WORD. * FRADQ29@ 
Cc x FRADO300 
CHAAKKKKRKAKRKREKKERERKEKKAREKERAKEEREREREEEREERERAERERERERERERERERER FRADQ@31¢@ 
Cc FRADO320 
INTEGER C(N) ,A(LMAX) ,P(10¢) ,Q,QTEMP,PP,B FRADO330 
COMMON /PRIMEB/ P, IPRIME(1@) FRAD 340 

IER = 1 FRADQ@350 

IF (N.LT.1 .OR. LMAX.LT.1) RETURN FRADQ36@ 

L=@ FRADG37@ 

DO 5 I=1,N FRADQ380 

C *KAT THIS STAGE A(1)+A(2)*B+...+A(L)*B**(L-1) IS THE FRAD@39@ 
Cc *KFIXED-RADIX REPRESENTATION OF C(N-I+2)+C (N-I+3)* FRADO400 
Cc *&kP (N-I+2)+...+C(N)*P(N-I+2)*...*P(N-1). FRADG410 
NI1 = N-I+1 FRAD@42@ 

PP = P(NII1) FRADQ43@ 

Q = C(NI1) FRAD@440 

IF (L.GT.@) GOTO 1 FRAD@456 

GOTO 3 FRAD@46¢ 

Cc THEN ... COMPUTE THE FIRST L COEFFICIENTS OF THE FRADG47@ 
Cc ... FIXED-RADIX REPRESENTATION OF C(N-I+1)+ FRADG48@ 
Cc »» P(N-I+1)* (A(1)+A(2)*B+.. +A (L)*B**(L=-1)). FRADG490 
1 DO 2 J=1,L FRAD@50@ 
QTEMP = A(J)*PP + Q FRAD@510 

Q = QTEMP/B FRAD@52@ 

2 A(J) = QTEMP — Q*B FRAD@530 
Cc OD FRAD@54@ 
Cc REPEAT ... CONVERT A(1)+A(2)*B+...+A(L)*B** (L-1) FRADO55@ 
C «e+ tQ*B**L TO FIXED-RADIX FORM. FRADG5606 
3 IF (Q.NE.@) GOTO 4 FRAD@57@¢ 
GOTO 5 FRAD@58¢@ 

Cc THEN FRADO59@ 
4 L = L+l FRADG600 
IF (L.GT.LMAX) RETURN FRADG61¢ 

QTEMP = Q/B FRAD@620 

A(L) = Q - QTEMP*B FRADG63@ 

Q = QTEMP FRAD@64@ 

GOTO 3 FRAD@65¢ 

C CONTINUE FRADO66¢ 
5 CONTINUEFRADG@6 70 
C OD FRAD@680 
IF (L.GE.2) GOTO 6 FRAD@69¢ 

GOTO 8 FRADG70@ 

c THEN ... REORDER THE COEFFICIENTS. FRADG71¢ 
6 L2 = L/2 FRADO72@ 
DO 7 I=1,L2 FRAD@7 3@ 

LI1 = L-I+1 FRAD@74@ 

QTEMP = A(I) FRADO75@ 

A(I) = A(LT1) FRADQ76@ 

7 A(LI1) = QTEMP FRADQ77@ 
Cc OD FRAD@78¢ 
8 IER = @ FRADG79@ 
RETURN FRADO80¢ 

END FRADG8106 
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ALGORITHM 523 
CONVEX, A New Convex Hull Algorithm for 
Planar Sets [Z| 


WILLIAM F, EDDY 
Carnegie-Mellon University 


Key Words and Phrases: convex hull, QUICKERSORT, partitioning, sorting 
CR Categories: 5.30, 5.31 
Language: Fortran 


DESCRIPTION 


An algorithm, CONVEX, that determines which points of a planar set are vertices 
of the convex hull of the set is presented here. A detailed explanation of its opera- 
tion and a report of a small sampling experiment are given in [1]. 


REFERENCES 


1. Eppy, W.F., A new convex hull algorithm for planar sets. ACM Trans. Math. Software 
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ALGORITHM 


COMMON NCOUNT 
DIMENSION XX(2,25),IN(25) ,IH(25) 
DIMENSION X(25),Y(25) 
INTEGER IWORK(5@) 
INTEGER IL(50) 
DATA IWORK/50*@/ 
NCOUNT=¢ 
C NCOUNT IS TOTAL NUMBER OF POINTS PASSED TO SPLIT 
READ (5,1)N 
i FORMAT (I5) 
WRITE(6,1)N 
Nl=N+1 
DO 2 I=1,N 
J=N1-1 
2 IN(J)=1 
C ARRAY IN CONTAINS INDICES 1-N IN REVERSE ORDER 
DO 3 I=1,N 
3 READ (5,4)XX(1,1) ,XX(2,1) 
4 FORMAT (2F1@.5) 
DO 5 I=1,N 
J=IN(I) 
5 WRITE (6,4) XX(1,J),XX(2,J) 
DO 1¢ M=4,N 
CALL CONVEX (N,XX,M, IN, IWORK, IWORK(N+1) , IH, NHULL, IL) 
IK=IL (1) 
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DO 6 I=1,NHULL 

J=IH (IK) 

X(1)=XX(1,J) 
¥(I)=XX(2,J) 

IK=IL(IK) 

WRITE (6, 7)M, NHULL,NCOUNT 


FORMAT (12H@SAMPLE SIZE ,15,9H VERTICES ,15,6H SPLIT s15) 


DO 8 I=1,NHULL 
WRITE (6,9)X(I) ,¥(I) 
FORMAT (1X, 2F10.5) 


i) CONTINUE 


STOP 
END 


SUBROUTINE SPLIT(N,X,M,IN,II,JJ,S, IABV,NA,MAXA, IBEL, 

1 NB,MAXB) 
THIS SUBROUTINE TAKES THE M POINTS OF ARRAY X WHOSE 
SUBSCRIPTS ARE IN ARRAY IN AND PARTITIONS THEM BY THE 
LINE JOINING THE TWO POINTS IN ARRAY X WHOSE SUBSCRIPTS 
ARE II AND JJ. THE SUBSCRIPTS OF THE POINTS ABOVE THE 
LINE ARE PUT INTO ARRAY IABV, AND THE SUBSCRIPTS OF THE 
POINTS BELOW ARE PUT INTO ARRAY IBEL. NA AND NB ARE, 
RESPECTIVELY, THE NUMBER OF POINTS ABOVE THE LINE AND THE 
NUMBER BELOW. MAXA AND MAXB ARE THE SUBSCRIPTS FOR ARRAY 
X OF THE POINT FURTHEST ABOVE THE LINE AND THE POINT 
FURTHEST BELOW, RESPECTIVELY. IF EITHER SUBSET IS NULL 
THE CORRESPONDING SUBSCRIPT (MAXA OR MAXB) IS SET IO ZERO 
FORMAL PARAMETERS 


INPUT 

N INTEGER TOTAL NUMBER OF DATA POINTS 

x REAL ARRAY (2,N) (X,Y) CO-ORDINATES OF THE DATA 

M INTEGER NUMBER OF POINTS IN INPUT SUBSET 

IN INTEGER ARRAY (M) SUBSCRIPTS FOR ARRAY X OF THE 
POINTS IN THE INPUT SUBSET 

II INTEGER SUBSCRIPT FOR ARRAY X OF ONE POINT 
ON THE PARTITIONING LINE 

JJ INTEGER SUBSCRIPT FOR ARRAY X OF ANOTHER 
POINT ON THE PARTITIONING LINE 

iS) INTEGER SWITCH TO DETERMINE OUTPUT. REFER 


TO COMMENTS BELOW 
OUTPUT 
IABV INTEGER ARRAY (M) SUBSCRIPTS FOR ARRAY X OF THE 
POINTS ABOVE THE PARTITIONING LINE 
NA INTEGER NUMBER OF ELEMENTS IN IABV 
MAXA INTEGER SUBSCRIPT FOR ARRAY X OF POINT 
FURTEEST ABOVE THE LINE. SET TO 
ZERO IF NA IS ZERO 
IBEL INTEGER ARRAY (M) SUBSCRIPTS FOR ARRAY X OF THE 
POINTS BELOW THE PARTITIONING LINE 
NB INTEGER NUMBER OF ELEMENTS IN IBEL 
MAXB INTEGER SUBSCRIPT FOR ARRAY X OF PCINT 
FURTHEST BELOW THE LINE. SET TO 
ZERO IF NB IS ZERO 
DIMENSION X(2,N) 
DIMENSION IN(M) , IABV(M) , [BEL (M) 
INTEGER $ 
IF S = 2 DONT SAVE IBEL,NB,MAXB. 
IF S =-2 DONT SAVE IABV,NA,MAXA. 
OTHERWISE SAVE EVERYTHING 
IF S IS POSITIVE THE ARRAY BEING PARTITIONED IS ABOVE 
THE INITIAL PARTITIONING LINE, IF IT IS NEGATIVE, THEN 
THE SET OF POINTS IS BELOW. 
LOGICAL T 
T=.FALSE. 
CHECK TO SEE IF THE LINE IS VERTICAL 
IF (X(1,JJ) .NE.X(1,II))GOTO 1 
XT=X(1, II) 
DIR=SIGN(1.,X(2,JJ)-X(2,II))*SIGN(1. ,FLOAT(S)) 
T=.TRUE. 
GOTO 2 
B=X(2,1I)-A*X(1,11) 
UP=¢. 
NA=@ 
MAXA=6 
DOWN=. 
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NB=@ 
MAXB=0 
DO 6 I=1,M 
IS=IN(I) 

IF(T)GOTO 3 
Z=X(2,I1S)-A*X(1,1S)-B 
GOTO 4 
Z=DIR* (X(1,1S)-XT) 
IF(Z.LE.@.)GOTO 5 

THE POINT IS ABOVE THE LINE 
IF(S.EQ.-2)GOTO 6 
NA=NA+1 
IABV (NA)=IS 
IF(Z.LT.UP)GOTO 6 
UP=Z 
MAXA=NA 
GOTO 6 
IF(S.EQ.2)GOTO 6 
IF(Z.GE.@.)GOTO 6 


THE POINT IS BELOW THE LINE 
NB=NB+1 


IBEL (NB)=IS 
IF(Z.GI.DOWN)GOTO 6 
DOWN=Z 
MAXB=NB 

CONTINUE 

RETURN 

END 


SUBROUTINE CONVEX(N,X,M, IN, IA, IB, IH,NH, IL) 
THIS SUBROUTINE DETERMINES WHICH OF THE M POINTS OF ARRAY 
X WHOSE SUBSCRIPTS ARE IN ARRAY IN ARE VERTICES OF THE 
MINIMUM AREA CONVEX POLYGON CONTAINING THE M POINTS. THE 
SUBSCRIPTS OF THE VERTICES ARE PLACED IN ARRAY IH IN THE 
ORDER THEY ARE FOUND. NH IS THE NUMBER OF ELEMENTS IN 
ARRAY IH AND ARRAY IL. ARRAY IL IS A LINKED LIST GIVING 
THE ORDER OF THE ELEMENTS OF ARRAY IH IN A COUNTER 
CLOCKWISE DIRECTION. THIS ALGORITHM CORRESPONDS TO A 
PREORDER TRAVERSAL OF A CERTAIN BINARY TREE. EACH VERTEX 
OF THE BINARY TREE REPRESENTS A SUBSET OF THE M POINTS. 
AT EACH STEP THE SUBSET OF POINTS CORRESPONDING TO THE 
CURRENT VERTEX OF THE TREE IS PARTITIONED BY A LINE 
JOINING TWO VERTICES OF THE CONVEX POLYGON. THE LEFT SON 
VERTEX IN THE BINARY TREE REPRESENTS THE SUBSET OF POINTS 
ABOVE THE PARTITIONING LINE AND THE RIGHT SON VERTEX, THE 
SUBSET BELOW THE LINE. THE LEAVES OF THE TREE REPRESENT 
EITHER NULL SUBSETS OR SUBSETS INSIDE A TRIANGLE WHOSE 
VERTICES COINCIDE WITH VERTICES OF THE CONVEX POLYGON. 
FORMAL PARAMETERS 
INPUT 
N INTEGER TOTAL NUMBER OF DATA POINTS 
X REAL ARRAY (2,N) (X,Y) CO-ORDINATES OF THE DATA 
M INTEGER NUMBER OF POINTS IN THE INPUT SUBSET 
IN INTEGER ARRAY (M) SUBSCRIPTS FOR ARRAY X OF THE POINTS 

IN THE INPUT SUBSET 

WORK AREA 
IA INTEGER ARRAY (M) SUBSCRIPTS FOR ARRAY X OF LEFT SON 


SUBSETS. SEE COMMENTS AFTER DIMENSION 


STATEMENTS 

IB INTEGER ARRAY (M) SUBSCRIPTS FOR ARRAY X OF RIGHT SON 
SUBSETS 

OUTPUT 

IH INTEGER ARRAY (M) SUBSCRIPTS FOR ARRAY X OF THE 
VERTICES OF THE CONVEX HULL 

NH INTEGER NUMBER OF ELEMENTS IN ARRAY IH AND 
ARRAY IL. SAME AS NUMBER OF VERTICES 
OF THE CONVEX POLYGON 

IL INTEGER ARRAY (M) A LINKED LIST GIVING IN ORDER IN A 
COUNTER-CLOCKWISE DIRECTION THE 


ELEMENTS OF ARRAY IH 
DIMENSION X(2,N) 
DIMENSION IN(M),IA(M),IB(M) ,TH(M) ,IL(M) 
THE UPPER END OF ARRAY IA IS USED TO STORE TEMPORARILY 
THE SIZES OF THE SUBSETS WHICH CORRESPOND TO RIGHT SON 
VERTICES, WHILE TRAVERSING DOWN THE LEFT SONS WHEN ON THE 
LEFT HALF OF THE TREE, AND TO STORE THE SIZES OF THE LEFT 
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C SONS WHILE TRAVERSING THE RIGHT SONS(DOWN THE RIGHT HALF) 
LOGICAL MAXE,MINE 
IF(M.EQ.1)GOTO 22 
IL(1)=2 
IL(2)=1 
KN=IN(1) 
KX=IN(2) 
IF(M.EQ.2)GOTO 21 
MP 1=M+1 
MIN=1 
Mx=1 
KX=IN(1) 
MAXE= FALSE. 
MINE=.FALSE. 
C FIND TWO VERTICES OF THE CONVEX HULL FOR THE INITIAL 
C PARTITION 
DO 6 I=2,M 
J=IN(I) 
IF(X(1,J)-X(1,KX))3,1,2 
1 MAXE= .TRUE. 
GOTO 3 
2 MAXE= . FALSE. 
MX=I 
KX=J 
3 IF(X(1,J)-X(1,KN))5,4,6 
4 MINE=.TRUE. 
GOTO 6 
5 MINE=.FALSE. 
MIN=I 
KN=J 
6 CONTINUE 
C IF THE MAX AND MIN ARE EQUAL, ALL M POINTS LIE ON A 
C VERTICAL LINE 
IF (KX.EQ.KN)GOTO 18 
IF MAXE (OR MINE) HAS THE VALUE TRUE THERE ARE SEVERAL 
MAXIMA (OR MINIMA) WITH EQUAL FIRST COORDINATES 
IF (MAXE.OR.MINE)GOTO 23 
7 IH(1)=KX 
IH(2)=KN 
NH=3 
INH=1 
NIB=1 
MA=M 
IN (MX) =IN(M) 
IN (M) =KX 
MM=M-2 
LF (MIN .EQ .M)MIN=MX 
IN (MIN) =IN(M-1) 
IN (M-1)=KN 
C BEGIN BY PARTITIONING THE ROOT OF THE TREE 
CALL SPLIT(N,X,MM, IN, IH(1) ,IH(2) ,6,IA,MB,MXA, IB, IA(MA), 
1 MXBB) 
FIRST TRAVERSE THE LEFT HALF OF THE TREE 
START WITH THE LEFT SON 
NIB=NIB+LA (MA) 
MA=MA-1 
9 IF (MXA.EQ.@)GOTO 11 
IL (NH) =IL (INH) 
IL (INH) =NH 
IH (NH)=IA (MXA) 
IA (MXA) =IA (MB) 
MB=MB-1 
NH=NH+1 
IF (MB.EQ.@)GOTO 1¢ 
ILINH=IL (INH) 
CALL SPLIT(N,X,MB,IA,IH(INH) , IH(ILINH) ,1,1A,MBB,MXA, 
1 IB(NIB),IA(MA) ,MXB) 
MB=MBB 
GOTO 8 
C THEN THE RIGHT SON 
16 INH=IL(LNH) 
11 INH=IL (INH) 
MA=MA+1 
NIB=NIB-LA (MA) 
IF(MA.GE.M)GOTO 12 
IF(IA(MA) .EQ.@)GOTO 11 
ILINH=IL (INH) 


oan 
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C ON THE LEFT SIDE OF THE TREE, THE RIGHT SON OF A RIGHT SON 
C MUST REPRESENT A SUBSET OF POINTS WHICH IS INSIDE A 
C TRIANGLE WITH VERTICES WHICH ARE ALSO VERTICES OF THE 
C CONVEX POLYGON AND HENCE THE SUBSET MAY BE NEGLECTED. 
CALL SPLIT(N,X,IA(MA) , IB(NIB) , IH(INH) , IH(ILINH) ,2,IA, 
1 MB,MXA,IB(NIB) ,MBB,MXB) 
TA (MA) =MBB 
GOTO 9 
C NOW TRAVERSE THE RIGHT HALF OF THE TREE 
12 MXB=MXBB 
MA=M 
MB=IA (MA) 
NIA=1 
TA(MA)=6 
C START WITH THE RIGHT SON 
13 NIA=NIA+IA (MA) 
MA=MA~1 
14 IF (MXB.EQ.@)GOTO 16 
IL (NH) =IL (INH) 
IL (INH) =NH 
TH (NH) =1B (MXB) 
IB (MXB)=1B (MB) 
MB=MB-1 
NH=NH+1 
IF (MB.EQ.@)GOTO 15 
ILINH=IL (INH) 
CALL SPLIT(N,X,MB,IB(NIB) , IH(INH) , IH(ILINH) ,-1, IA(NIA), 
1 IA(MA) ,MXA,1B(NIB) ,MBB,MXB) 
MB=MBB 
GOTO 13 
C THEN THE LEFT SON 
15 INH=IL (INH) 
16 INH=IL (INH) 
MA=MA+1 
NIA=NIA-IA (MA) 
IF (MA.EQ.MP1)GOTO 17 
IF (IA(MA) .EQ.@)GOTO 16 
ILINH=IL (INH) 
C ON THE RIGHT SIDE OF THE TREE, THE LEFT SON OF A LEFT SON 
C MUST REPRESENT A SUBSET OF POINTS WHICH IS INSIDE A 
C TRIANGLE WITH VERTICES WHICH ARE ALSO VERTICES OF THE 
C CONVEX POLYGON AND HENCE THE SUBSET MAY BE NEGLECTED. 
CALL SPLIT(N,X,IA(MA) , IA(NIA) , IH( INH) , IH(ILINH) ,-2, 
1 IA(NIA) ,MBB,MXA,IB(NIB) ,MB,MXB) 
GOTO 14 
17 NH=NH-1 
RETURN 
C ALL THE SPECIAL CASES ARE HANDLED DOWN HERE 
C IF ALL THE POINTS LIE ON A VERTICAL LINE 
18 KX=IN(1) 
KN=IN (1) 
DO 2¢ I=1,M 
J=IN(1) 
IF (X(2,J) .LE.X(2,KX))GOTO 19 
MX=I 
KX=J 
19 IF(X(2,J) .GE.X(2,KN))GOTO 20 
MIN=1 
KN=J 
20 CONTINUE 
IF (KX.EQ.KN)GOTO 22 
C IF THERE ARE ONLY TWO POINTS 
21 TH(1)=KX 
TH(2)=KN 
NH=3 
IF ((X(1,KN) .EQ.X(1,KX)) .AND. (X(2,KN) .EQ.X(2,KX)) )NH=2 
GOTO 17 
C IF THERE IS ONLY ONE POINT 
22 NH=2 
TH(1)=IN(1) 
IL(1)=1 
GOTO 17 
C MULTIPLE EXTREMES ARE HANDLED HERE 
C IF THERE ARE SEVERAL POINTS WITH THE (SAME) LARGEST 
C FIRST COORDINATE 
23 IF(.NOT.MAXE)GOTO 25 
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DO 24 I=1,M 
J=IN(I) 
IF (X(1,J) .NE.X(1,KX))GOTO 24 
IF (X(2,J) .LE.X(2,KX))GOTO 24 
MX=I 
KX=J 
24 CONTINUE 
C IF THERE ARE SEVERAL POINTS WITH THE (SAME) SMALLEST 
C FIRST COORDINATE 
25 IF(.NOT.MINE)GOTO 7 
DO 26 I=1,M 
J=IN(I) 
IF(X(1,J).NE.X(1,KN))GOTO 26 
IF (X(2,J).GE.X(2,KN))GOTO 26 


MIN=I 
KN=J 
26 CONTINUE 
GOTO 7 
END 
26 
2.0 ) 
1.73 -1.0 
1.¢ 1.73 
oe) 2.0 
@.1 @.1 
-1.0 -1.73 
@.2 -9.2 
-1.73 1.0 
-9.3 ¢.3 
6.0 -2.¢ 
-0.4 -0.4 
-2.0 0.0 
¢.5 ¢.5 
1.73 1.0 
0.6 -9.6 
-1.0 1.73 
-¢.7 0.7 
-1.73 -1.6 
-9.8 -6.8 


COLLECTED ALGORITHMS FROM CACM 
524-P 1- 0 


ALGORITHM 524 


MP, A Fortran Multiple-Precision Arithmetic 
Package [Al1| 


RICHARD P, BRENT 
Australian National University 


Key Words and Phrases: arithmetic, multiple precision, extended precision, floating 
point, elementary function evaluation, Euler’s constant, gamma function, polyalgorithm, 
software package, Fortran, machine-independent software, special function evaluation, 
Bessel functions, exponential integral, logarithmic intergral, Bernoulli numbers, zeta 
function, portable software 

CR Categories: 3.15, 4.49, 5.11, 5.12, 5.15, 5.19, 5.25 

Language: Fortran 


DESCRIPTION 


The design of the package and the theoretical background for the algorithms used 
are given in [1]. Details of calling sequences, etc., are given in the comments in- 
cluded here and in [2]. 
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ALGORITHM 


[Only that portion of the listing which gives the introductory comments and a 
small example program is printed here. The complete listing, together with a Users’ 
Guide giving further details, is available from the ACM Algorithms Distribution 


Service. 

C ABCDEFGHIJKLMNOPQRSTUVWXYZ$@123456789+-*/=(),. MPOOGG1¢ 
Cc MPOG00620 
C $$ REKKKK COMMENTS *eeeKK MPGO0030 
Cc MPOOOO40 
C DESCRIPTION OF MP (VERSION OF 17 FEBRUARY 1977) MP¢G0051 
C KEAKAKKKARKKAAKKARE MPGGOG6¢6 
Cc MPOGOO70 
C MP IS A MULTIPLE-PRECISION ARITHMETIC PACKAGE. MPOGOO8O 
C IT IS ALMOST COMPLETELY MACHINE-INDEPENDENT, AND SHOULD MPOGG096 
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RUN ON ANY MACHINE WITH AN ANSI STANDARD FORTRAN COMPILER, 
SUFFICIENT MEMORY, AND A WORDLENGTH OF AT LEAST 16 BITS. 
SOME MODIFICATIONS WOULD BE NECESSARY FOR A WORDLENGTH 

OF LESS THAN 16 BITS. 


MP WAS WRITTEN BY R. BRENT (COMPUTER CENTRE, AUSTRALIAN 
NATIONAL UNIVERSITY), IN NOVEMBER 1973 (VERSION 1). 
CORRESPONDENCE SHOULD BE SENT TO R. P. BRENT, COMPUTER 
CENTRE, ANU, BOX 4, CANBERRA, ACT 26466, AUSTRALIA. 


MP HAS BEEN TESTED ON A UNIVAC 1148 (E LEVEL FORTRAN V), 
A UNIVAC 1166/42 (E AND T LEVEL FORTRAN V, ASCII FORTRAN, 
AND RALPH), A PDP 16 (FORTRAN 10(/NOOPT) AND FORTRAN 4), 
AN IBM 366/50 (FORTRAN G AND FORTRAN H, OPT = 2), 

AN IBM 366/91 AND 374/168 (FORTRAN H EXTENDED, OPT = 2), 
A CYBER 76 (FIN 4.2, OPT = 1) AND A PDP 11/45 (DOS). 
THESE MACHINES HAVE EFFECTIVE INTEGER WORDLENGTHS RANGING 
FROM 16 TO 48 BITS. 


MP WORKS WITH NORMALIZED FLOATING-POINT NUMBERS. 

THE BASE (B) AND NUMBER OF DIGITS (T) ARE 

ARBITRARY (SUBJECT TO SOME RESTRICTIONS GIVEN BELOW), 
AND MAY BE VARIED DYNAMICALLY. 


T-DIGIT FLOATING-POINT NUMBERS ARE STORED IN INTEGER ARRAYS OF 
DIMENSION T+2, WITH THE FOLLOWING CONVENTIONS - 

WORD 1 = SIGN (@, -1 OR +1) 

WORD 2 = EXPONENT (TO BASE B) 

WORDS 3 TO T+2 = NORMALIZED FRACTION 
NOTE THAT WORDS 2 TO T+2 ARE UNDEFINED IF SIGN = @. 


ARITHMETIC IS ROUNDED, AND FOUR GUARD DIGITS ARE USED 

FOR ADDITION AND MULTIPLICATION, SO THE CORRECTLY ROUNDED 
RESULT IS USUALLY PRODUCED. DIVISION, SQRT ETC ARE DONE 

BY NEWIONS METHOD, BUT GIVE THE EXACT RESULT IF IT CAN BE 
REPRESENTED WITH T-2 DIGITS. OTHER ROUTINES (MPSIN, MPLN ETC) 
USUALLY GIVE A RESULT Y = F(X) WHICH COULD BE OBTAINED 

BY MAKING AN O(B**(1-T)) PERTURBATION IN X, EVALUATING F 
EXACTLY, THEN MAKING AN 0(B**(1-T)) PERTURBATION IN Y. 


EXPONENTS CAN LIE IN THE RANGE -M, 
WHERE M IS SET BY THE USER. 

ON UNDERFLOW DURING AN ARITHMETIC OPERATION, THE RESULT 

IS SET TO ZERO BY SUBROUTINE MPUNFL. 

ON OVERFLOW SUBROUTINE MPOVFL IS CALLED AND EXECUTION 

IS TERMINATED WITH AN ERROR MESSAGE. 

ERROR MESSAGES ARE PRINTED ON LOGICAL UNIT LUN, WHERE LUN 
IS SET BY THE USER, AND THEN EXECUTION IS TERMINATED 

BY A CALL TO SUBROUTINE MPERR. IT IS ASSUMED THAT LOGICAL 
RECORDS OF UP TO 8@ CHARACTERS MAY BE WRITTEN ON UNIT LUN. 
A WORKING ARRAY OF SIZE MXR (SEE BELOW) MUST BE PROVIDED 
IN COMMON. 


.-. , +M INCLUSIVE, 


THE PARAMETERS B, T, M, LUN AND MXR ARE PASSED TO THE UTILITY 
ROUTINES IN COMMON, TOGETHER WLTH A WORKING ARRAY R WHICH 
MUST BE SUFFICIENTLY LARGE (SEE BELOW). MOST ROUTINES 
USE THE STATEMENTS - 
COMMON B, T, M, LUN, MXR, R 
INTEGER B, T, R(1) 
AND IT IS ASSUMED THAT R IS DIMENSIONED SUFFICIENTLY LARGE 
IN THE CALLING PROGRAM, AND THAT MXR IS SET TO THE 
DIMENSION OF R IN THE CALLING PROGRAM. 
WARNING - IT IS ASSUMED THAT THE COMPILER PASSES ADDRESSES OF 
xkkRKKR ~~ ARRAYS USED AS ARGUMENTS IN SUBROUTINE CALLS (I.E., CALL 
BY REFERENCE), AND DOES NOT CHECK FOR ARRAY BOUNDS 
VIOLATIONS (EITHER FOR ARGUMENTS OR FOR ARRAYS IN COMMON) . 
APART FROM THESE VIOLATIONS, MP IS WRITTEN ENTIRELY IN 
ANSI STANDARD FORTRAN (ANSI X3.9-1966). THIS HAS BEEN 
CHECKED BY THE PFORT VERIFIER. 


RESTRICTIONS - 
B (THE BASE) MUST BE AT LEAST 2, 
T (NUMBER OF DIGITS) MUST BE AT LEAST 2, 
M (EXPONENT RANGE) MUST BE GREATER THAN T AND LESS 
THAN 1/4 THE LARGEST MACHINE-REPRESENTABLE INTEGER, 
8*B**2-]1 MUST BE NO GREATER THAN THE LARGEST MACHINE- 


MPOOO1060 
MPOOG110 
MPO9G120 
MPGOG130 
MPOOG14¢ 
MPOGG150 
MPOGG160 
MPOGG170 
MPGOG180 
MPGO9 190 
MPOOG6200 
MPOG0210 
MPOOO220 
MPGOO230 
MPOOO246 
MPGO9250 


-MPOG9O260 


MPOGG270 
MPOO928¢ 
MPOO9290 
MPOOO300 
MP990310 
MPGO9320 
MPO00330 
MPGO9340 
MPOOO350 
MPOOG360 
MPOG6370 
MPOG6386 
MPGO0390 
MPOOG400 
MPOOG410 
MPOG0420 
MP9O0436 
MPGOG446 
MPOOO450 
MPOO0466 
MPOGO470 
MPOG0486 
MPOOG496 
MPOOO500 
MPOOO510 
MPOGO520 
MPOGO536 
MPOG0540 
MPOG9550 
MPGO0560 
MPOOO57¢ 
MPG9G580 
MPOOG590 
MPOOG600 
MPOO620 
MPGOG630 
MPYO0640 
MPOO0650 
MPOOG660 
MPOOG670 
MPOO9680 
MPGG0690 
MPGOG700 
MPOO07 16 
MPGOO720 
MPO90730 
MPOGO746 
MPOO0750 
MPOGO760 
MPOG07 76 
MPOOO7 86 
MPOO0790 
MPGOO806 
MPGO081¢ 
MPOG0820 
MPOO083¢ 
MPOOO84O 
MPOOO85¢ 
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REPRESENTABLE INTEGER, AND. THE INTEGERS @, 1, ... , B 
MUST BE EXACTLY REPRESENTABLE AS SINGLE-PRECISION FLOATING- 
POINT NUMBERS, AND 

B**(T-1) SHOULD BE AT LEAST 1@**7. 


B AND T MAY BE SET TO GIVE THE EQUIVALENT OF A SPECIFIED 
NUMBER OF DECIMAL PLACES BY CALLING MPSET (SEE BELOW), OR MAY 
BE SET DIRECTLY BY THE USER. IF MPSET IS NOT CALLED, THE USER 
MUST REMEMBER TO INITIALIZE M, LUN AMD MXR (SEE ABOVE) AS WELL 
AS B AND T BEFORE CALLING ANY MP ROUTINES. 


FOR EFFICIENCY CHOOSE B FAIRLY LARGE, SUBJECT TO THE RESTRICTIONS 
GIVEN ABOVE. FOR EXAMPLE, IF THE WORDLENGTH IS 


48 BITS, COULD USE B = 4194364 OR 14666000, 
36 BITS, COULD USE B = 65536 OR 146060¢, 

32 BITS, COULD USE B = 16384 OR 16404, 

24 BITS, COULD USE B = 1624 OR 1049, 

18 BITS, COULD USE B = 128 OR 149, 

16 BITS, COULD USE B = 64 OR 1@. 


AVOID MULTIPLICATION OR DIVISION BY MP NUMBERS, AS 
THESE TAKE 0(T**2) OPERATIONS, WHEREAS MULT./DIV. BY 
INTEGERS TAKE O(T) OPERATIONS. 


MP NUMBERS USED AS ARGUMENTS OF SUBROUTINES NEED NOT BE 
DISTINCT. FOR EXAMPLE, 

CALL MPADD (X, Y, Y) OR CALL MPEXP (X, X) ARE OK. 
HOWEVER, DISTINCT ARRAYS WHICH OVERLAP SHOULD NOT BE USED. 


FOR ADDITIONAL DETAILS SEE - A FORTRAN MULTIPLE-PRECISION 
ARITHMETIC PACKAGE (BY R. P. BRENT), TO APPEAR IN ACM 
TRANSACTIONS ON MATHEMATICAL SOFTWARE (AVAILABLE AS A 
CARNEGIE-MELLON UNIV. COMPUTER SCIENCE DEPT. REPORT, 
PITTSBURGH, PENNSYLVANIA, MAY 1976) AND THE MP USERS GUIDE. 


SUMMARY OF MP ROUTINES 
HRREKKERERRERKRERERERE 


BASIC ARITHMETIC - MPADD, MPADDI, MPADDQ, MPDIV, MPDIVI, 
MPMUL, MPMULI, MPMULQ, MPREC, MPSUB 


POWERS AND ROOTS - MPPWR, MPPWR2, MPQPWR, MPROOT, MPSQRT 

ELEMENTARY FUNCTIONS - MPASIN, MPATAN, MPCOS, MPCOSH, MPEXP, 
MPLN, MPLNGS, MPLNI, MPSIN, MPSINH, MPTAN, 
MPTANH 


SPECIAL FUNCTIONS - MPBESJ, MPDAW, MPEI, MPERF, MPERFC, 
MPGAM, MPGAMQ, MPLI, MPLNGM 


CONSTANTS ~- MPBERN, MPEPS, MPEUL, MPMAXR, MPMINR, MPPI, 
MPPIGL, MPZETA 


INPUT AND OUTPUT - MPDUMP, MPIN, MPINE, MPOUT, MPOUTE, MPOUT2 


CONVERSION - MPCDM, MPCIM, MPCMD, CPCMDE, MPCMEF, MPCMI, 
MPCMIM, MPCMR, MPCMRE, MPCQM, MPCRM 


COMPARISON - MPCMPA, MPCMPI, MPCMPR, MPCOMP 


GENERAL UTILITY ROUTINES - MPABS, MPCLR, MPCMF, MPMAX, MPMIN, 
MPNEG, MPPACK, MPPOLY, MPSET, MPSTR, MPUNPK 


ERROR DETECTION AND HANDLING - MPCHK, MPERR, MPOVFL, MPUNFL 
TEST PROGRAMS - EXAMPLE, TEST, TESTV, TEST2 


MISCELLANEOUS ROUTINES USED BY THE ABOVE — MPADD2, MPADD3, 
MPART1, MPBES2, MPERF2, MPERF3, MPEXP1, 
MPEXT, MPGCD, MPHANK, MPLNS, MPL235, 
MPMLP, MPMUL2, MPNZR, MPSIN1, MP4@D, 
MP4GE, MP4@F, MP40G, TIMEMP 


LIST OF MP ROUTINES 
KERKKRERERRERRERERE 


MPGOG860 
MPOG0876 
MPOGG880 
MPOGG890 
MPGOG960 
MPOGG910 
MPOGG920 
MPOG0930 
MPOOG940 
MPO9G956 
MPOGG960 
MPOG0970 
MPOGG980 
MPOOG990 
MPOG19600 
MPOO1010 
MPOG1620 
MPOG1630 
MPOG1640 
MPOG10650 
MPOG10660 
MPOG1970 
MPGO1080 
MPOG169¢ 
MPOG1100 
MPGG111¢ 
MPOP112¢ 
MPOG1130 
MP06114¢ 
MP00115¢ 
MPOG116¢ 
MPGG1170 
MPGG118¢@ 
MPGO119¢ 
MPOO1260 
MPG0121¢ 
MPG06122¢ 
MPGG123¢ 
MPO91240 
MPOG1250 
MPOG126¢ 
MPOG1276 
MPOG1280 
MPGO129¢@ 
MPGO130¢ 
MPGG131¢ 
MP9G1320 
MPG6133¢ 
MPGG1340 
MP$01350 
MP00136¢ 
MPO¢1376 
MPO¢138¢ 
MP00139¢ 
MPO91406 
MP9G141¢ 
MPG@142¢@ 
MPO0143¢ 
MP00144¢6 
MPGO145@ 
MPGG146@ 
MP0¢147¢ 
MPGG148¢ 
MPO01490 
MP$O1500 
MPO@1510 
MPGG1526 
MP@6153@ 
MPGO1546 
MP9@155@ 
MPOO1560 
MPG6157@ 
MPQO1586 
MPG6159¢ 
MPGO1600 
MPGG161¢ 
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COLLECTED ALGORITHMS (cont.) 


MANQAQAAQAANANQANQAAAANAANANANAANANAANDANNANNAAMANMADAANNANNNNNNNNAaANNaAanANaNaAaANnNgNNgNnANaNgaAANANANANggaANgagaAaANAgaanaaNn 


THE ROUTINES PROVIDED IN MP ARE LISTED BELOW. 


CALLING SEQUENCES, RESTRICTIONS, ACCURACY, AND ERROR CONDITIONS, 


SEE THE COMMENTS IN EACH ROUTINE. 
OF R IN COMMON) IS T+4 WORDS UNLESS NOTED BELOW. 
INDICATED BY * ARE THOSE MOST LIKELY TO BE OF INTEREST TO THE USER. 


THE ROUTINES 


FOR FAST EXECUTION THE ROUTINES WHICH SHOULD BE OPTIMIZED ARE 
MPNZR, MPMLP, MPDIVI, MPADD2, MPADD3, AND MPMUL2. 


IN THE LIST BELOW AN MP NUMBER MEANS A MULTIPLE-PREC SION 
NUMBER AS DESCRIBED ABOVE, M(T) MEANS THE TIME TO MULTIPLY TWO 


T-DIGIT MP NUMBERS (SEE MPMUL), AN INTEGER MEANS A SINGLE-PRECISION 


INTEGER, A RATIONAL NUMBER MEANS THE RATIO OF TWO INTEGERS. 


Xx, Y, 
AND RI, RX, 


-»» ARE MP NUMBERS, 


I, J, ... ARE INTEGERS, 


»»». ARE SINGLE-PRECISION REAL NUMBERS. 


TIME BOUNDS SUCH AS O(T**2) ARE AS T TENDS TO INFINITY 
WITH EVERYTHING ELSE FIXED. 


* 
* 


*& 


EXAMPLE 
MPABS 


MPADD 


A SMALL MAIN PROGRAM GIVING AN EXAMPLE OF THE USE OF MP. 


COMPUTES ABSOLUTE VALUE OF AN MP NUMBER 

CALL MPABS (X, Y) MEANS Y = ABS(X) 

ADDS TWO MP NUMBERS 

CALL MPADD (X, Y, Z) MEANS Z=X+Y 

ADDS AN MP NUMBER TO AN INTEGER, 

GIVING A MULTIPLE-PRECISION RESULT, SPACE = 2T+6 
CALL MPADDI (X, IY, Z) MEANS Z = X + IY 

ADDS A RATIONAL NUMBER TO AN MP NUMBER, 

SPACE = 2T+6 

CALL MPADDQ (X, I, J, Y) MEANS Y = X + I/J 
ROUTINE CALLED BY MPADD AND MPSUB 

ROUTINE CALLED BY MPADD2 

COMPUTES ARCTAN(1/N) FOR N .GT. 1 (CALLED BY MPPI) 
SPACE = 2T+6 

COMPUTES ARCSIN OF AN MP NUMBER, 

USING AN O(M(T)T) METHOD, SPACE = 5T+12 

CALL MPASIN (X, Y) MEANS Y = ARCSIN(X) 

COMPUTES ARCTAN OF AN MP NUMBER 

USING AN O(T.M(T)) ALGORITHM, SPACE = 5T+12 
CALL MPATAN (X, Y) MEANS Y = ARCTAN(X) 

COMPUTES BERNOULLI NUMBERS B2, B4, B6, ... 
SPACE = 8T+18 

COMPUTES BESSEL FUNCTION J(NU,X) FOR MF X 

AND SMALL INTEGER NU, SPACE = 14T+156 

CALL MPBESJ (X, NU, Y) MEANS Y = J(NU,X) 
ROUTINE CALLED BY MPBESJ (USES BACKWARD) RECURRENCE 
TO EVALUATE J(NU,X)), SPACE = 8T+18 

CONVERTS DOUBLE-PRECISION TO MULTIPLE-PRECISION 
PRINTS ERROR MESSAGE ON UNIT LUN IF B, T, M OR MXR 
IS ILLEGAL, OR ON UNIT 6 IF LUN IS ILLEGAL 

(LUN SHOULD BE IN RANGE 1 TO 99) 

CONVERTS INTEGER TO MULTIPLE-PRECISION 

CALL MPCIM (IX, Z) MEANS Z = IX 

SETS SOME DIGITS OF AN MP NUMBER TO ZERO 
CONVERTS AN MP NUMBER TO DOUBLE-PRECIS.ION REAL 
CONVERTS AN MP NUMBER TO (DOUBLE-PRECISION) 
FRACTION AND (DECIMAL) EXPONENT, 

SPACE = 6T+14 

CONVERTS MP NUMBER TO FRACTION AND (DECIMAL) 
EXPONENT, SPACE = 5T+12 

FINDS FRACTIONAL PART OF AN MP NUMBER 

CONVERTS AN MP NUMBER TO AN INTEGER 


CONVERTS AN MP NUMBER TO A MULTIPLE-PRECISION INTEGER 


COMPARES ABSOLUTE VALUES OF TWO MP NUMBERS 
MPCMPA (X, Y) RETURNS SIGN(ABS (X)-ABS(Y)) 
COMPARES AN MP NUMBER WITH AN INTEGER, SPACE = 2T+6 
MPCMPI (X, I) RETURNS SIGN(X-I) 

COMPARES AN MP NUMBER WITH A REAL, SPACE = 2T+6 
MPCMPR (X, RI) RETURNS SIGN(X-RI) 

CONVERTS AN MP NUMBER TO (SINGLE-PRECISION) REAL 
CALL MPCMR (X, RZ) MEANS RZ = SNGL(X) 

CONVERTS AN MP NUMBER TO EXPONENT AND 
(SINGLE-PRECISION) FRACTION, I.E. F*1@**I 

SPACE = 6T+14 

COMPARES TWO MP NUMBERS 

MPCOMP (X, Y) RETURNS SIGN(X-Y) 

COMPUTES COSINE OF AN MP NUMBER, USING AN 
O(M(T)T/LOG(T)) METHOD, SPACE = 5T+12 


FOR MORE DETAILS OF 


SPACE REQUIRED (I.E. DIMENSION 


MP601620 
MPOO163¢ 
MPGG1646 
MPOO165¢ 
MPOO1660 
MPOG1670 
MPOG1680 
MPOG1690 
MPOO1700 
MPOG1710 
MPG0172¢ 
MPQG173¢ 
MPOG1740 
MPGO175@ 
MPOO1760 
MPOO1776 
MPOG178¢ 
MPGO1790 
MPOO1800 
MPGO181¢ 
MPO¢182¢ 
MPOO1830 
MPO¢1846 
MP00185¢ 
MPGO1860 
MPOG1876 
MPOO188 

MPOOLE99 
MPGO1960 
MP9G191¢ 
MPOG192¢ 
MPG9O193¢ 
MPOG1946 
MPG0195¢ 
MPG91960 
MPGO197¢ 
MPGG1980 
MPGO199¢ 
MPOO20060 
MPOO2010 
MPQO202¢ 
MPGO20630 
MPOO2040 
MPG92650 
MPOG20660 
MPGO2076 
MPGO20686 
MPGO2690 
MPOO2100 
MP¢@2110 
MPOO2120 
MP$06213¢ 
MP9G2146 
MPQ06215¢ 
MPOO2160 
MPG92176 
MPOO218¢0 
MP992190 
MPOO2200 
MPGG2210 
MPGO2226 
MPOG2230 
MPO06224¢6 
MPGO225¢ 
MPOG226¢ 
MPQ02276 
MP9O228¢ 
MPOG2290 
MPGO2300 
MP$062310 
MPOO2326 
MPQ0623306 
MPOG2340 
MPG02356 
MPGO2360 
MP$02376 
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COLLECTED ALGORITHMS (cont.) 


QANQAANQAAQANAAAAAANAQANQANAAAQAAQAAAAQAAANQAAAANQAAANAGAANAQANQNANAANDAQAAAAAAAQAAANQAAIAAANDANRNAAARQAANRAAAANRAANAAN 


* MPCOSH 


* MPCQM 
MPCRM 


* = MPDAW 


* MPDIV 


* MPDIVI 


MPDUMP 


* MPEI 


* MPEPS 


* MPERF 


* MPERFC 


MPERF2 
MPERF3 
MPERR 


* MPEUL 


MPLNGS 


* MPLNI 


CALL MPCOS (X, Y) MEANS Y = COS(X) 

COMPUTES. HYPERBOLIC COSINE OF AN MP NUMBER 
USING MPEXP, SPACE = 5T+12 

CALL MPCOSH (X, Y) MEANS Y = COSH(X) 

CONVERTS A RATIONAL NUMBER TO MULTIPLE-PRECISION 
CALL MPCQM (I, J, Q) MEANS Q = I/J 

CONVERTS REAL TO MULTIPLE-PRECISION 

CALL MPCRM (RX, Z) MEANS Z = RX 
COMPUTES DAWSONS INTEGRAL, DAW(X) 
FROM @ TO X OF EXP(U**2) DU), SPACE = 5T+17 

CALL MPDAW (X, Y) MEANS Y = DAW(X) 

DIVIDES TWO MP NUMBERS, SPACE = 4T+1¢ 

CALL MPDIV (X, Y, Z) MEANS Z = X/Y 

DIVIDES AN MP NUMBER BY AN INTEGER 

USING AN O(T) METHOD (MUCH FASTER THAN MPDIV) 

CALL MPDIVI (X, IY, Z) MEANS Z = X/IY 

DUMPS AN MP NUMBER (USEFUL FOR DEBUGGING) 

CALL MPDUMP (X) DUMPS THE MP NUMBER X ON UNIT LUN 
EVALUATES EXPONENTIAL INTEGRAL OF AN MP NUMBER, 
SPACE = 19T+31 

CALL MPEI (X, Y) MEANS Y = EI(X) 

COMPUTES THE (MULTIPLE-PRECISION) MACHINE PRECISION 
CALL MPEPS (X) MEANS X = @.5*B**(1-T) IF B EVEN 
COMPUTES ERROR FUNCTION OF AN MP NUMBER, 

SPACE = 5T+12 

CALL MPERF (X, Y) MEANS Y = ERF(X) 

COMPUTES COMPLEMENTARY ERROR FUNCTION OF AN MP NUMBER, 
SPACE = 12T+26 

CALL MPERFC (X, Y) MEANS Y = ERFC(X) 

COMPUTES EXP (X*X)* (INTEGRAL FROM @ TO X OF 

EXP (-U*U) DU), CALLED BY MPERF, SPACE = 5T+12 
ROUTINE CALLED BY MPERF, MPDAW AND MPERFC, 

SPACE = 4T+19 

ERROR HANDLING ROUTINE (TERMINATES EXECUTION AT 
PRESENT BUT MAY EASILY BE MODIFIED). 

RETURNS EULERS CONSTANT (GAMMA = @.57721566...) TO 
MULTIPLE-PRECISION ACCURACY, SPACE = 5T+14 

CALL MPEUL (G) MEANS G = $.57721566... 

COMPUTES EXPONENTIAL OF A MULTIPLE-PRECISION 

NUMBER, USING AN O(SQRT(T)M(T)) METHOD, SPACE = 4T+1¢ 
CALL MPEXP (X, Y) MEANS Y = EXP(X) 

COMPUTES EXP(X)-1 FOR ABS(X) .LT. 1 (CALLED BY 
MPEXP, MPSINH AND MPTANH), SPACE = 3T+8 

A ROUNDING ROUTINE CALLED BY MPDIV AND MPSQRT 
COMPUTES GAMMA FUNCTION OF AN MP ARGUMENT, 

SPACE SAME AS FOR MPLNGM (IN WORST CASE) 

CALL MPGAM (X, Y) MEANS ¥ = GAMMA(X) 

COMPUTES GAMMA FUNCTION OF A RATIONAL ARGUMENT, 
USING AN O(T**2) METHOD, SPACE = 6T+12 

CALL MPGAMQ (I, J, X) MEANS X = GAMMA(I/J) 

DIVIDES TWO INTEGERS BY THEIR GREATEST COMMON DIVISOR 
(CALLED BY MPMULQ, MPGAMQ, ETC) 

ROUTINE CALLED BY MPBESJ (EVALUATES HANKELS ASYMPTOTIC 
SERIES FOR BESSEL FUNCTIONS), SPACE = 11T+24 
CONVERTS FIXED-POINT NUMBER READ UNDER Al FORMAT 

TO MULTIPLE-PRECISION, SPACE = 3T+11 

SAME AS MPIN BUT RESULT IS MULTIPLIED BY A POWER OF 
TEN (USEFUL FOR READING IN FLOATING-POINT NUMBERS) , 
SPACE = 5T+12 

EVALUATES LOGARITHMIC INTEGRAL LI(X), SPACE = 19T+31 
CALL MPLI (X, Y) MEANS Y = LI(X) 

COMPUTES NATURAL LOG OF AN MP NUMBER, 

USING AN O(SQRT(T).M(T)) METHOD, SPACE = 6T+14 

CALL MPLN (X, Y) MEANS Y = LN(X) 

COMPUTES LN(GAMMA(X)) FOR POSITIVE MP X, 

USING STIRLINGS APPROXIMATION, 

SPACE = 11T+24+NL*((T+3)/2), WHERE NL IS THE NUMBER 
OF TERMS USED IN THE ASYMPTOTIC EXPANSION, 

NL .LE. (2 + T*LN(B)/8) 

CALL MPLNGM (X, Y) MEANS Y = LN(GAMMA(X)) 

COMPUTES NATURAL LOG OF AN MP NUMBER, USING 

THE GAUSS-SALAMIN ALGORITHM. | RECOMMENDED FOR 
TESTING MPLN AND MPLNI ONLY (UNLESS T LARGE). 

SPACE = 6T+26 

COMPUTES NATURAL LOG OF AN INTEGER, USING AN 

O(T**2) METHOD (FASTER THAN MPLN), SPACE = 3T+8 


= EXP (-X*#2)* (INTEGRAL 


MP$G238¢6 
MPOG2390 
MPOO2460 
MPGG2410 
MPO0242¢ 
MPGO243¢ 
MPG0244¢ 
MP9G62450 
MPGG2460 
MP¢G2470 
MPG624806 
MPGO249¢ 
MPGO2500 
MP9G62510 
MPOG252¢ 
MPQ0253¢ 
MPO¢254¢ 
MPO92550 
MPOG2560 
MP¢62570 
MPOO258¢ 
MPGO259¢ 
MPOG2600 
MPGO261¢ 
MPOO2620 
MPOG2630 
MPOG62640 
MPG$2650 
MPOO2660 
MPO02670 
MPG626806 
MPOG269¢ 
MPOG2700 
MPOG2710 
MPOQ2720 
MP902730 
MP9G274¢ 
MPQ062750@ 
MPGO2760 
MPOG2776 
MPOG278¢ 
MPGO2796 
MPOG2806 
MPOG281¢ 
MPGO2820 
MPG6283¢ 
MPG02846 
MPOO2850 
MPOG2860 
MPQO287¢ 
MPGO288¢6 
MPGG2890 
MPOO2900 
MPGG2910 
MPOG2920 
MPG0293¢ 
MPOG2946 
MPOO2950 
MPOG2960 
MPQ62976 
MPOG2980 
MPOO2990 
MPGO30600 
MPGO3010 
MPOG362¢ 
MPG93030 
MPOG30640 
MP0063650 
MP9O3066 
MPOO3070 
MPOO308¢ 
MPOO3090 
MPOG3100 
MP9O3110 
MPGO3120 
MP663130 
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COLLECTED ALGORITHMS (cont.) 


ANMQAAQAAAAQAANAAANQNANQNANQANQANANQAQAAQAAANDANQANQANDQAANQANQANDANQAAAAAAANANANANAANRANDANNAAANANAANAANNRAaANANANAAaANAN 


MPLNS 
MPL235 


MPMAX 


MPMAXR 


MPMIN 
MPMINR 
MPMLP 
MPMUL 
MPMULI 
MPMULQ 


MPMUL2 
MPNEG 


MPNZR 


MPOUT 


MPOUTE 
MPOUT2 
MPOVFL 


MPPACK 


MPPI 


MPPIGL 


MPPOLY 


MPPWR 


MPPWR2 


MPQPWR 


MPREC 


MPROOT 


MPSET 


MPSIN 


MPSINH 


MPSIN1 


MPSQRT 


CALL MPLNI (N, X) MEANS X = LN(N) 

COMPUTES LN(1+X) FOR SMALL MP X. SPACE = 5T+12 
COMPUTES NATURAL LOG OF AN INTEGER WHOSE PRIME 
FACTORS ARE 2, 3 AND/OR 5 (CALLED BY MPLNI), 
SPACE = 3T+8 

COMPUTES THE MAXIMUM OF TWO MP NUMBERS 

CALL MPMAX (X, Y, Z) MEANS Z = MAX(X,Y) 

COMPUTES THE LARGEST POSITIVE MP NUMBER 

CALL MPMAXR (X) MEANS X = MP NUMBER WITH EXPONENT M 
AND ALL DIGITS B-1 

COMPUTES THE MINIMUM OF TWO MP NUMBERS 

CALL MPMIN (X, Y, Z) MEANS Z = MIN(X,Y) 

RETURNS THE SMALLEST NORMALIZED POSITIVE MP NUMBER 
CALL MPMINR (X) MEANS X = B**(-M-1) 

INNER LOOP ROUTINE CALLED BY MPMUL 

MULTIPLIES TWO MP NUMBERS 

USING AN M(T) = O(T**2) ALGORITHM 

CALL MPMUL (X, Y, Z) MEANS Z = X*Y 

MULTIPLIES AN MP NUMBER BY AN 

INTEGER USING AN 0(T) METHOD (FASTER THAN MPMUL) 
CALL MPMULI (X, IY, Z) MEANS Z = X*IY 

MULTIPLIES MP NUMBER BY A RATIONAL NUMBER 

CALL MPMULQ (X, I, J, Y) MEANS Y = X*I/J 

ROUTINE CALLED BY MPMULI 

REVERSES SIGN OF AN MP NUMBER 

CALL MPNEG (X, Y) MEANS Y = -X 

NORMALIZES AND ROUNDS OR TRUNCATES (CALLED BY 
MPADD2, MPDIVI, MPMUL AND MPMUL2) 

CONVERTS MULTIPLE-PRECISION TO A FORM SUITABLE FOR 
PRINTING UNDER Al FORMAT (CORRESPONDS 10 F OR I 
FORMATS), SPACE = 3T+11 

SIMILAR TO MPOUT BUT GIVES (DECIMAL) EXPONENT AND 
FRACTION (CORRESPONDS TO E FORMAT), SPACE = 6T+14 
SAME AS MPOUT BUT ANY BASE FROM 2 TO 16 MAY BE 
USED FOR OUTPUT REPRESENTATION, SPACE = 3T+11 
ROUTINE CALLED ON MULTIPLE-PRECISION OVERFLOW 
(CALLS MPERR AT PRESENT BUT EASILY MODIFIED) 
PACKS MP NUMBERS INTO ARRAYS OF DIMENSION 

(T+3)/2 (USEFUL TO SAVE SPACE), 

UNPACKING MAY BE PERFORMED WITH MPUNPK 

RETURNS PI TO MULTIPLE-PRECISION ACCURACY, 

USING AN O(T**2) METHOD, SPACE = 3T+8 

CALL MPPI (X) MEANS X = 3.14159265... 

RETURNS PI TO MULTIPLE-PRECISION ACCURACY, 

USING GAUSS-LEGENDRE 0(LOG(T)M(T)) METHOD, 
RECOMMENDED FOR TESTING MPPI ONLY, SPACE = 6T+14 
EVALUATES A POLYNOMIAL WITH INTEGER COEFFICIENTS, 
SPACE = 3T+8 

RAISES MP NUMBER TO INTEGER POWER, 

SPACE = 4T+1¢ 

CALL MPPWR (X, N, Y) MEANS Y = X*4N 

RAISES NONNEGATIVE MP NUMBER TO MP POWER, 

SPACE = 7T+16 

CALL MPPWR2 (X, Y, Z) MEANS Z = X**Y 

RAISES RATIONAL NUMBER TO RATIONAL POWER, 

SPACE = 4T+19 

CALL MPQPWR (I, J, K, L, X) MEANS X = (I/J)**(K/L) 
FORMS RECIPROCAL OF MP NUMBER, 

USING NEWIONS METHOD, SPACE = 4T+1¢ 

CALL MPREC (X, Y) MEANS Y = 1/X 

COMPUTES THE N-TH ROOT OF AN MP NUMBER 

USING NEWIONS METHOD, SPACE = 4T+1¢ 

CALL MPROOT (X, N, Y) MEANS Y = X**(1/N) 

SETS THE BASE B AND DIGITS T ETC GIVEN THE 
EQUIVALENT NUMBER OF DECIMAL PLACES REQUIRED 
WARNING - MAY CAUSE AN INTEGER OVERFLOW, 

xkKAKAK == FOR DETAILS SEE COMMENTS IN MPSET 
COMPUTES SINE OF AN MP NUMBER, 

USING AN O(M(T)T/LOG(T)) METHOD, SPACE = 5T+12 
CALL MPSIN (X, Y) MEANS Y = SIN(X) 

COMPUTES HYPERBOLIC SINE OF AN MP NUMBER, 

USING MPEXP, SPACE = 5T+12 

CALL MPSINH (X, Y) MEANS Y = SINH(X) 

COMPUTES SIN(X) OR COS(X) FOR ABS(X) .LE. 1, CALLED 
BY MPSIN, MPCOS AND MPTAN, SPACE = 3T+& 

COMPUTES SQUARE ROOT OF A NONNEGATIVE MP NUMBER, 


MPOO3146 
MPG03150 
MPG03160 
MPGO3176 
MPGO3180 
MPGO319¢ 
MPGO3200 
MPGO3216 
MPG6322¢ 
MP903230 
MPO93240 
MPGO3250 
MPO03260 
MPGG3270 
MPGO328¢ 
MPOO3290 
MP963300 
MPO9331¢ 
MPO9332¢ 
MP$93330 
MP063340 
MPG0335¢ 
MP¢03360 
MP0063370 
MPG03380 
MPO¢3390 
MPOO3400 
MPOO3410 
MPG93420 
MP0O3430 
MPO93440 
MPGO3450 
MPGO3466 
MPOG347¢ 
MPOG348¢ 
MPOO3496 
MPO63500 
MPO93510 
MPOO3520 
MPOO3530 
MPGO3540 
MPOG355¢ 
MPOG3560 
MP00357¢ 
MPG93580 
MPO0¢3590 
MPG63600 
MPOO361¢ 
MPOO3620 
MP¢03636 
MP¢0364¢ 
MPG93650 
MPOG3660 
MPGO3670 
MPOG3680 
MPO03690 
MPGO3700 
MP$¢3710 
MPGO3720 
MPG03730 
MPOO3746 
MPG03750 
MPG93760 
MPOO377¢ 
MP903780 
MPO03796 
MPOG3800 
MPGO3810 
MP0G3820 
MPOO3830 
MPO063846 
MP$$3850 
MPOO386¢ 
MPG$O3870 
MPO963880 
MPG93890 
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AADAANQAAAAAANDAAAGAAAAGAAAAAAANQANAAQANTCANNQAAAQAANAAQAQAAAQAAQAQANQANAANAANDANNNANAANRNANQaAaANNANAANANANRAANAARDAAAADA 


USING NEWIONS METHOD, SPACE = 4T+1¢ 
CALL MPSQRT (X, Y) MEANS Y = SQRT(X) 


* MPSTR STORES ONE MP NUMBER IN ANOTHER 
CALL MPSTR (X, Y) MEANS Y = X 
* MPSUB SUBTRACTS ONE MP NUMBER FROM ANOTHER 
CALL MPSUB (X, Y, Z) MEANS Z =X -Y 
* MPTAN COMPUTES TAN OF AN MP NUMBER, 


USING MPSINI, SPACE = 6T+2¢ 
CALL MPTAN (X, Y) MEANS Y = TAN(X) 
* MPTANH COMPUTES HYPERBOLIC TAN OF AN MP NUMBER, 
USING MPEXP, SPACE = 5T+12 
CALL MPTANH (X, Y) MEANS Y = TANH(X) 
MPUNFL ROUTINE CALLED ON MULTIPLE-PRECISION UNDERFLOW 
(SETS RESULT TO ZERO AT PRESENT BUT EASILY MODIFIED) 
* MPUNPK UNPACKS AN ARRAY FORMED BY MPPACK TO GIVE AN MP 
NUMBER IN STANDARD FORMAT 
* MPZETA COMPUTES RIEMANN ZETA FUNCTION FOR POSITIVE 
INTEGER ARGUMENTS 
SPACE = 8T+18+NL* ((T+3)/2), WHERE NL IS THE 
NUMBER OF TERMS USED IN THE ASYMPTOTIC 
EXPANSION, NL .LE. (1 + 0.1*T*LN(B)) 
CALL MPZETA (N, X) MEANS X = ZETA(N) 
* MP4@D OUTPUT ROUTINE CALLED BY TEST PROGRAM, 
USEFUL FOR EASY FIXED-POINT OUTPUT, 
SPACE = 3T+N+14 FOR N DECIMAL PLACE OUTPUT 
CALL MP4@D (N, X) WRITES X TO N DECIMAL PLACES ON UNIT 
LUN, ASSUMING ABS(X) .LT. 1¢ 
MP4GE OUTPUT ROUTINE CALLED BY MP4@D 
* MP4OF OUTPUT ROUTINE CALLED BY TEST2 PROGRAM, 
USEFUL FOR EASY FLOATING-POINT OUTPUT, 
SPACE = 6T+N+17 FOR N SIGNIFICANT FIGURE OUTPUT 
CALL MP4@F (N, X) WRITES X TO N SIGNIFICANT FIGURES 
(IN DECIMAL EXPONENT AND FRACTION FORM) ON UNIT LUN 
MP40G OUTPUT ROUTINE CALLED BY MP4@F 
* TEST A MAIN PROGRAM WHICH TESTS SOME. OF THE ROUTINES IN MP 
WHILE COMPUTING VARIOUS CONSTANTS TO 4@ DECIMAL PLACES 
TESTV A VERSION OF TEST WITH VARIABLE-PRECISION COMPUTATION 
AND OUTPUT 
* TEST2 ANOTHER TEST PROGRAM WHICH TESTS ROUTINES 
NOT CALLED BY TEST OR TESTV 
TIMEMP A MACHINE-DEPENDENT FUNCTION CALLED BY TESTV, SHOULD 
BE MODIFIED BY THE USER BEFORE TESTV IS RUN. 


INDEX 
KEKKK 


THE STARTING LINE SEQUENCE NUMBERS (GIVEN IN COLUMNS 73-8¢@) 
OF THE MP ROUTINES ARE AS FOLLOWS. 


COMMENTS MPOG0063¢ 
EXAMPLE MPOO546¢ 
MPABS MPOG619¢ 
MPADD MPOG627¢ 
MPADDI MPOG635¢ 
MPADDQ MPGO651¢ 
MPADD2 MPGG6630 
MPADD3 MP9O723¢ 
MPART1 MPG9813¢ 
MPASIN MPOG861¢ 
MPATAN MPOG899¢ 
MPBERN MPGG961¢ 
MPBESJ MPG16760 
MPBES2 MPG119¢¢ 
MPCDM MP@1258¢ 
MPCHK MP@1325¢ 
MPCIM MPO1376@ 
MPCLR MPO1463¢ 
MPCMD MPO1416¢ 
MPCMDE MPQ1456¢ 
MPCMEF MPO1479¢ 
MPCMF MPO155060 
MPCMI MPO1582¢ 
MPCMIM MP@1625¢ 
MPCMPA MPO1648¢ 
MPCMPI MPO1664¢ 


MPCMPR MP¢16800 


MPOO3906 
MPGO3910 
MPGO392¢ 
MPG9393¢ 
MPOO394@ 
MPO9O395¢@ 
MPOO396¢ 
MP90397¢ 
MPO¢398¢6 
MPOG3990 
MPOO4000 
MPOG4G10 
MPOG4020 
MPGG4030 
MPOG4040 
MPOG4050 
MPO04060 
MPGO407¢ 
MPOG40680 
MPG0469¢ 
MPGO4100 
MP@G41106 
MP@@412@ 
MPG06413¢ 
MPOG4146 
MPGO415¢ 
MP0O4160 
MPO04170 
MPG04180 
MPG04190 
MPOG4260 
MPGG4210 
MPOG4226 
MPG64230 
MPOG4246 
MPGO425¢ 
MPOG4260 
MP0G4276 
MPOO4280 
MPOO4290 
MPOO4300 
MPOG6431¢ 
MPOG4320 
MPOG4330 
MPO04340 
MP06435¢ 
MPGO436¢ 
MPG0437¢ 
MPG04380 
MPGG4390 
MPOO4400 
MP~G4416 
MPOG4426 
MPO04436 
MPOO4440 
MP0O4450 
MPOG4460 
MPOG4476 
MPOG4486 
MPG0449¢ 
MPOG4500 
MPG04510 
MPOG4520 
MPGG4530 
MPOG4540 
MPO04550 
MPO04566 
MPOG4570 
MP¢0458¢ 
MPOG4590 
MPOG4600 
MPGO461¢ 
MPGO4620 
MPGO463¢ 
MPOO4640 
MPO0465¢6 
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MPCMR 
MPCMRE 
MPCOMP 
MPCOS 
MPCOSH 
MPCQM 
MPCRM 
MPDAW 
MPDIV 
MPDIVI 
MPDUMP 
MPEI 
MPEPS 
MPERF 
MPERFC 
MPERF2 
MPERF3 
MPERR 
MPEUL 
MPEXP 
MPEXP1 
MPEXT 
MPGAM 
MPGAMQ 
MPGCD 
MPHANK 
MPIN 
MPINE 
MPLI 
MPLN 
MPLNGM 
MPLNGS 
MPLNI 
MPLNS 
MPL235 
MPMAX 
MPMAXR 
MPMIN 
MPMINR 
MPMLP 
MPMUL 
MPMULI 
MPMULQ 
MPMUL2 
MPNEG 
MPNZR 
MPOUT 
MPOUTE 
MPOUT2 
MPOVFL 
MPPACK 
MPPI 
MPPIGL 
MPPOLY 
MPPWR 
MPPWR2 
MPQPWR 
MPREC 
MPROOT 
MPSET 
MPSIN 
MPSINH 
MPSINL 
MPSQRT 
MPSTR 
MPSUB 
MPTAN 
MPTANH 
MPUNFL 
MPUNPK 
MPZETA 
MP4@D 
MP4@E 
MP4OF 
MP46G 
TEST 


MPO1696¢ 
MP@17310 
MPO1753¢@ 
MPG1788¢ 
MP¢1817¢ 
MPO1843¢ 
MPO1863¢ 
MPG19260 
MPO1990¢ 
MP¢20638¢0 
MP@2151¢ 
MPG21770 
MP$2295¢ 
MPO23240 
MP@2381¢6 
MPG24310 
MPO24846 
MPO25390 
MP¢2558¢ 
MP$26340 
MPO27370 
MPO280600 
MPO28240 
MPO2995¢ 
MPO30360 
MPO30560 
MPO31396 
MPO3257@ 
MPO33920 
MPO3338¢ 
MPG33946 
MPG3481¢ 
MPG35580 
MP$3663¢ 
MP¢3730¢ 
MPO37830 
MP@37950 
MPO38110 
MPO38230 
MPG38390 
MPG38490 
MP$39246 
MPO39340 
MPO39600 
MPG46486 
MPO4056¢ 
MP941370 
MPQ41520 
MPO4184¢6 
MPG43230 
MPO43440 
MPQ43710 
MP@4397¢ 
MPO44420 
MPO44700 
MP@45130 
MP04544@ 
MPO46170 
MPO46980 
MPG4804¢ 
MPO4881¢ 
MPG49480 
MPO4986¢ 
MPO50644¢ 
MPO50680 
MPO5689¢ 
MPG506986 
MPG51610 
MPO520600 
MPQ52150 
MPG52446 
MP@53590 
MP@53760 
MPO5390¢ 
MPO54080 
MPG54226 


MPGO466¢ 
MPOO4670 
MPOO4680 
MPOO4690 
MPGO4700 
MPO0471¢ 
MPG04720 
MPOO4736 
MPG04740 
MPOO475¢ 
MPGO4760 
MPG64770 
MPO04780 
MPOO4790 
MPOG4860 
MPGO4810 
MPOO4820 
MPO04830 
MPOO484¢ 
MP00485¢ 
MPGO4860 
MPGO4870 
MP¢04880 
MPO04890 
MPOO4900 
MPOO4910 
MPGO4926 
MPG0493¢6 
MPGO4940 
MPG0495¢ 
MPOG4960 
MPG64976 
MPOO4980 
MPGO499¢ 
MPOO5000 
MPOG5G10 
MPOO5020 
MP665030 
MPOO5040 
MPG0505¢ 
MPOG5060 
MPGO5070 
MPOO5080 
MPGO5090 
MP$051060 
MPG06511¢ 
MPG¢O51206 
MPGO513¢ 
MPG0514@ 
MPGO515¢ 
MPGO5160 
MPQO5170 
MPQ05180 
MPGG5190 
MPGO5200 
MPG05210 
MP@@5220 
MPGO5230 
MPGO5 240 
MPG0525¢ 
MP905260 
MPOG527¢ 
MPOO5280 
MPOO529¢0 
MPGO5300 
MP$0531¢ 
MP0¢532¢ 
MPG95330 
MPOG5340 
MPO065350 
MP@O5360@ 
MPG05370 
MPG0538¢ 
MPGO5390 
MPGO5400 
MP606541¢ 
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aAAANn aaa (oe ke me) 


aa 


TESTV MPG56063¢ 
TEST2 MPO57940 
TIMEMP MPQ6414¢ 


Bed 
Bea 


kAKKKK EXAMPLE *kkk#K 


THIS PROGRAM COMPUTES PI AND EXP(PI*SQRT(163/9)) TO 160 
DECIMAL PLACES, AND EXP(PI*SQRT(163)) TO 9@ DECIMAL PLACES, 


AND WRITES THEM ON LOGICAL UNIT 6. EXECUTION 


TIME ON A UNIVAC 1108 (WITH FORTRAN SE1D) IS 1.651 SECONDS. 


TO RUN EXAMPLE THE FOLLOWING MP ROUTINES ARE REQUIRED ~ MPABS, 
MPADD, MPADDI, MPADD2, MPADD3, MPART1, MPCHK, MPCIM, MPCLR, MPCMF, 
MPCMI, MPCMPR, MPCMR, MPCOMP, MPCQM, MPCRM, MPDIVI, MPERR, 

MPEXP, MPEXP1, MPGCD, MPLNI, MPL235, MPMAXR, MPMLP, MPMUL, 

MPMULI, MPMULQ, MPMUL2, MPNZR, MPOUT, MPOUT2, MPOVFL, MPPI, 
MPPWR, MPQPWR, MPREC, MPROOT, MPSET, MPSTR, MPSUB, MPUNFL. 


CORRECT OUTPUT (EXCLUDING HEADINGS) IS AS FOLLOWS 


MPG0542¢ 
MPO0543¢ 
MPOG5440 
MPOG545¢@ 
MPOG5460 
MPOO5470 
MPO05480 
MPGO5496 
MPOG5500 
MPOG5510 
MP905526 
MPO9553@ 
MPOG5540 
MP@0555¢ 
MPO05560 
MPOO5570 
MPOG5580 
MP$G559¢ 
MPOG5600 
MP¢05616 


3.14159265358979323846264338327950288419716939937510 MPGG5620 
58209749445923078164962862089986280348253421170680 MPGG5630 

649320 . 660000000604 86373564901663947174181881853947577148 MPOG564¢ 
57603665918194652218258286942536340815822646477590 MPGO5650 

262537412646768743 .99999999999925007 2597 19818568887 935385633733699086 MPOO566¢ 


27975374196378219647916118667312951181346 


CERTAIN PARAMETERS AND WORKING SPACE IN COMMON. 
COMMON B, T, M, LUN, MXR, R 


MPEXP REQUIRES 4T+1@ WORDS AND WE HAVE T .LE. 62 IF WORDLENGTH 
AT LEAST 16 BITS, SO 4T+1@ .LE. 258. DIMENSIONS CAN BE REDUCED 


IF WORDLENGTH IS GREATER THAN 16 BITS. 
INTEGER B, T, R(258) 


VARIABLES NEED T+2 .LE. 64 WORDS AND ALLOW 11@ CHARACTERS FOR 


DECIMAL OUTPUT 
INTEGER PI(64), X(64), C(11@) 


CALL MPSET TO SET OUTPUT LOGICAL UNIT = 6 AND EQUIVALENT 
NUMBER OF DECIMAL PLACES TO AT LEAST 110. THE LAST TWO 


PARAMETERS ARE THE DIMENSIONS OF PI (OR X) AND R. 
CALL MPSET (6, 110, 64, 258) 


COMPUTE MULTIPLE-PRECISION PI 
CALL MPPI(PTI) 


CONVERT TO PRINTABLE FORMAT (F11¢.1¢¢) AND WRITE 
CALL MPOUT (PI, C, 11, 100) 
WRITE (LUN, 16) B, T, C 
1@ FORMAT (32H1EXAMPLE OF MP PACKAGE, BASE =, 19, 
$ 12H, DIGITS =, 14 /// 11H PI TO 1¢@D // 
$ 11X, 6@Al / 21X, 5@A1) 


SET X = SQRT(163/9), THEN MULTIPLY BY PI 
CALL MPQPWR (163, 9, 1, 2, X) 
CALL MPMUL (X, PI, X) 


SET X = EXP(X) 
CALL MPEXP (X, X) 


CONVERT TO PRINTABLE FORMAT AND WRITE 
CALL MPOUT (X, C, 116, 14) 
WRITE (LUN, 26) C 
2@ FORMAT (/ 28H EXP(PI*SQRT(163/9)) TO 1¢@D // 
$ 11X, 6@Al / 21X, 5@A1) 


SET X = X**3 = EXP(PI*SQRT(163)) 
CALL MPPWR (X, 3, X) 


WRITE IN FORMAT F11¢.9¢ 
CALL MPOUT (X, C, 114, 90) 
WRITE (LUN, 3¢) C 
3@ FORMAT (/ 25H EXP(PI*SQRT(163)) TO 9@D // 
$ 1X, 7@Al / 21X, 4@A1) 
STOP 
END 


MPOG567¢ 
MPOO5680 
MPGO5690 
MPOO5760 
MPG6571¢ 
MPOG5720 
MPGO573¢ 
MPOO5746 
MPGG5750 
MPO0576¢ 
MPGG5770 
MPGO5780 
MPOO5790 
MPG05806 
MPO95810 
MPOG5826 
MP¢0583¢ 
MPO0584¢ 
MPG0585¢ 
MPOG586¢ 
MPG0587@ 
MPG6588¢ 
MPOG5890 
MPOG59060 
MPG5910 
MPO0592¢ 
MPOG5930 
MPG0594¢ 
MP$G5950 
MPOG5960 
MPGG5970 
MPGO5980 
MP¢6599¢ 
MPOGEGOO 
MPGO6610 
MPGG6020 
MPOG6030 
MPGG6040 
MPOG6050 
MPOG6060 
MP9G6070 
MPOG6080 
MPOG6G90 
MPGG6100 
MPOG611¢ 
MPG06126 
MPO0613¢ 
MPGG6146 
MPO0615¢ 
MPO0616¢ 
MPGG6170 
MPOG6180 
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REMARK ON ALGORITHM 524 
MP, A Fortran Multiple-Precision Arithmetic Package [A1] 
[R.P. Brent, ACM Trans. Math. Software 4, 1 (March 1978), 71-81] 


R.P. Brent [Recd 7 Aug. 1978 and 6 Dec. 1978] 
Department of Computer Science, Australian National University, P.O. Box 4, 
Canberra, ACT 2600, Australia 


A new version of the Fortran multiple-precision arithmetic package MP, which 
is described in [1] and given as ACM Algorithm 524, is now available from the 
ACM Algorithms Distribution Service. The new version may be used with the 
Augment preprocessor [4], and the necessary interface routines and description 
deck, described in [2], are supplied. The MP Users’ Guide (also supplied with the 
package) has been revised to describe the Augment interface routines and the 
use of MP via Augment. 

The new version incorporates faster algorithms for the exponential integral and 
Euler’s constant [3]. Consequently, the TEST2 program described in [1] now 
runs about 10 percent faster. 

In versions of MP dated June 7, 1978, and earlier (including Algorithm 524), 
there may be an error in the least significant digit when multiple-precision 
numbers with the same sign and exponent are added using subroutine MPADD. 
To correct this, change .LT. to .LE. in line MP007390 of MPADD3. 
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ALGORITHM 


{Only summary information of the revised version of the algorithm is printed 
here. This listing is available from the ACM Algorithms Distribution Service (see 
inside back cover for order form) and will be supplied to those requesting 
Algorithm 524. | 


NAME(n): indicates a Fortran module from the MP package with n records 

NAME*(n): indicates “NAME” is included as an example 

NAME'(n): indicates “NAME?” is part of the test package 

NAME"(n): indicates a listing of the user guide 

NAME*(n): indicates an Augment description deck and Jacobi program 
using it 

Contents: EXAMPLE'(111), MPABS(8), MPAD)D(8), MPADDI(16), 
MPADDQ(12), MPADD2(60), MPADD3(90), MPART1(48), 
MPASIN(38), MPATAN(62), MPBASA(9), MPBASB(13), 
MPBERN(115), MPBESJ(114), MPBES2(68), MPCAM(44), 
MPCDM(67), MPCHK(51), MPCIM(26), MPCLR(13), 
MPCMD(40), MPCMDE(23), MPCMEF(71), MPCMF(32), 
MPCMI(43), MPCMIM(23), MPCMPA(16), MPCMPI(16), 
MPCMPR(16), MPCMR(35), MPCMRE(22), MPCOMP(35), 
MPCOS(29), MPCOSH(26), MPCQM (20), MPCRM (63), 
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MPDAW(64), MPDGA(10), MPDGB(21), MPDIGA(9), 
MPDIGB(14), MPDIV(48), MPDIVI(113), MPDUMP(26), 
MPEI(156), MPEPS(29), MPEQ(7), MPERF(57), MPERFC(50), 
MPERF2(53), MPERF3(55), MPERR(19), MPEUL(76), 
MPEXP(103), MPEXPA(11), MPEXPB(24), MPEXP1(63), 
MPEXT(24), MPGAM(81), MPGAMQ(125), MPGCD(26), 
MPGCDA(78), MPGCDB(38), MPGE(7), MPGT(7), 
MPHANK(83), MPIN(118), MPINE(45), MPINF(27), 
MPINIT(39), MPIO(19), MPKSTR(15), MPLE(7), MPLI(386), 
MPLN(56), MPLNGM(87), MPLNGS(77), MPLNI(105), 
MPLNS(67), MPLT(7), MPL235(53), MPMAX(12),: 
MPMAXR(16), MPMEXA(9), MPMEXB(18), MPMIN(12), 
MPMINR(16), MPMLP(10), MPMUL(75), MPMULI(10), 
MPMULQ(26), MPMUL2(88), MPNE(7), MPNEG(8), 
MPNZR(81), MPOUT(15), MPOUTE(32), MPOUTF(25), 
MPOUT2(139), MPOVFL(21), MPPACK(27), MPPI(26), 
MPPIGL(45), MPPOLY (28), MPPWR(43), MPPWR2(3]1), 
MPQPWR(73), MPREC(81), MPROOT(102), MPSET(77), 
MPSIGA(7), MPSIGB(24), MPSIN(67), MPSINH(38), 
MPSIN1(58), MPSQRT(24), MPSTR(21), MPSUB(9), 
MPTAN(63), MPTANH(39), MPUNFL(15), MPUNPK(29), 
MPUPK (45), MPZETA(115), MP40D7(17), MP40E"(14), 
MP40F™(18), MP40G"(15), TEST™ (181), TESTV" (191), 
TEST2™(620), TIMEMP" (28), GUIDE"(1719), AUGDECK4(159) 
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ALGORITHM 525 
ADAPT, Adaptive Smooth Curve Fitting [E2]| 


JOHN R. RICE 
Purdue University 


Key Words and Phrases: piecewise polynomial approximation, adaptive curve fitting, 
adaptive approximation, Hermite interpolation, function approximation 

CR Categories: 5.13 

Language: Fortran 


DESCRIPTION 


1. Introduction and Background 


The basic objectives of this function approximation algorithm are: speed, relia- 
bility, and smoothness. Algorithms already exist with any two of these three prop- 
erties. Speed requires that the work be proportional to the length of the curve (for 
fixed accuracy and more or less uniform complexity of the function). Reliability 
requires that curves with singularities or near singularities, oscillations, and other 
complex behavior be handled. Smoothness (number of continuous derivatives) 
of the approximation obtained is input to the algorithm. The author believes that 
adaptive piecewise polynomial algorithms offer the best hope for such algorithms 
with nonadaptive piecewise polynomial schemes or rational function approximation 
as the only serious competitors. Nonadaptive schemes do not cope efficiently with 
functions having very nonuniform behavior (singularities in slopes, for example) 
and the work for rational approximation probably increases faster than linearly 
with the length of the curve. | 

The theoretical background for this algorithm is provided by Rice [1] and the 
references cited there. This may be summarized by saying that for given fixed degree 
n of the pieces the error of the best piecewise polynomial approximation behaves 
like k~* where k is the number of pieces. This theoretical result applies to a broad 
class of functions which includes everything that conceivably could arise in appli- 
cations. A class of adaptive algorithms has been found which chooses the knots so 
that the error behaves like k~™ even though the best approximation is not obtained. 
These algorithms apply to any piecewise smooth function with a finite number of 
“algebraic” singularities, i.c. to any function I*(x) which behaves like a + b(x — s)* 
near the singularity s. The exponent a must give a finite valuc for the norm of 
I(x) specified for ADAPT to use, i.c. a > —4# for least squares, a > 0 for uniform 
approximation. 
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The key ingredients in these algorithms arc a local approximation operator, a 
local error estimator, and a data structure for the subintervals generated. ADAPT 
uses Hermite interpolation at subinterval endpoints plus ordinary interpolation 
in between if needed. Error estimates are made by a simple Gauss quadrature 
formula and a stack is used for the intervals. This algorithm is probably the sim- 
plest choice from those currently known to give the optimal convergence rate. A 
more detailed description of ADAPT is given in Section 5. Note that the nature of 
ADAPT requires that F(x) and its derivatives be available for arbitrary x (see [2] 
for guidance on numerically estimating derivatives) and thus ADAPT is not di- 
rectly applicable to discrete data sets. 

Section 2 presents some remarks about the algorithm components; most of them 
incorporate rather standard methods. Section 3 discusses the use of ADAPT (input/ 
output, role of the arguments CHARF = characteristic length of F(x) and EDIST 
= error distribution type, and portability). Section 4 describes the extensive testing 
performed and summarizes the algorithm properties observed in [2]. It also briefly 
describes the driver program and 20 functions with derivatives used for testing 
ADAPT which are applicable to similar algorithms. The final section has a very 
high level description of the algorithm; ADAPT itself is available through the 
ACM Algorithms Distribution Service. 


2. The Principal Algorithm Components 


The algorithm ADAPT is to approximate the function F(x) on the interval [A,B] 
to within an accuracy ACCUR by piecewise polynomials of degree DEGREE with 
a number SMOOTH of continuous derivatives. The error is measured in the L,- 
norm with p set by NORM. Other input is the characteristic length CHARF of F, 
printed output level LEVEL, the error distribution type EDIST, and the number 
NBREAK of breakpoints (plus information about the breakpoints if NBREAK 
> 0). Breakpoints are points where there are breaks in the curve or its derivatives: 
knots are placed there and special calculations made. The output is the array 
XKNOTS of knots, the coefficients COEFS (relative to the knot locations) of the 
polynomial pieces, the estimated error ERROR, and number KNOTS of knots. 
The approximation obtained is automatically available as the FUNCTION sub- 
program PPOLY. 

2.1 Data Structure and Discard Procedure for Subintervals. ADAPT generates a 
set of subintervals of [A,B] which are maintained in a stack with the leftmost on 
the top. Since subintervals are created by halving, the rnaximum size of the stack is 
limited by the machine word length. 

Intervals are discarded whenever the estimated error on an interval is small 
enough. This decision made in the subprogram CHECK is somewhat subtle and 
three strategies are provided. This question is discussed later in some detail in 
connection with the argument EDIST which indicates the strategy selected by the 
user. Two subprograms, PUT and TAKE, are used for access to the interval stack. 

2.2 Hermite Interpolation. The values of DEGREE and SMOOTH are specified 
by the user with DEGREE > 2 * SMOOTH + 1. The polynomial pieces are de- 
termined by interpolating F and SMOOTH derivatives of F at each endpoint of 
a subinterval plus the value of F at DEGREE — 2 « SMOOTH — 1 other points. 
During the computation the polynomial pieces are represented by divided differ- 
ences computed in NEWTON and used by POLYDD. Once a polynomial piece is 
accepted for the final approximation PTRANS transforms its representation into 
powers with origin at the left endpoint of the subinterval. The transformation is 
accomplished by repeated synthetic division. The subprogram COMPUT controls 
the computation of a polynomial piece as well as the error estimation. 

2.3 The Breakpoint Mechanism. It is sometimes very useful for a user to be 
able to specify breaks in some derivative at certain points. Most commonly one 
has a known or desired jump in the slope at a given point and ADAPT allows this 
via NBREAK and associated arguments XBREAK, DBREAK, BLEFT, BRIGHT 
which specify the exact nature of the breakpoint. This rather straightforward 
facility is implemented primarily in TAKE with some impact on COMPUT. 
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2.4 Error Estimation. The Lp-norm of the local error is estimated in ERRINT 
by a 4-point Gauss quadrature for (F — POLYDD)««P on the subinterval under 
consideration. Special code is used for P = infinity (minimax approximation). The 
global error estimate is built up in PUT by appropriately combining the local 
error estimates. 

2.5 Fatal Errors. The algorithm normally terminates when the stack is empty. 
The stack should not overflow but might do so at very strong singularities which 
cause the algorithm to want to operate at accuracies inconsistent with the machine 
word length. This overflow has not occurred in the testing so far, but if it does a 
message such as the following is printed: 


INTERVAL DIVIDED TOO MUCH, EXCEEDED LIMIT 50 ON INTERVAL STACK 
AT 

17923.12345678  17923,12345687 

INTERVAL DISCARDED AND COMPUTATION CONTINUED 


This message may be suppressed by setting LEVEL = —1, but note that the com- 
putation is allowed to proceed on the conjecture that this situation is not truly 
fatal. 

A strong singularity has been observed to cause another situation indicated by a 
message like 


GOT SHORT INTERVAL #««« 3210.12345678 3210.12345679 **«* DISCARD IT 


which may also be suppressed by setting LEVEL = —1. Experiments indicate 
that the algorithm will recover and produce satisfactory results provided it can 
discard (and ignore) enough short intervals to get out of the region where the ma- 
chine word length is inadequate. It often cannot get out of this region before ex- 
ceeding run time limits or, more likely, the limit on the number of knots. The 
variable BUFFER, in PUT governs short interval detection. 

The arrays XKNOTS and COEFS are passed to ADAPT with variable dimensions 
KDIMEN and NDIMEN. If the number of knots computed exceeds KDIMEN 
then a fatal error message is printed and the computation aborted. This message 
cannot be suppressed. Checks are made on various input parameters by SETUP 
and inconsistent or impossible input leads to fatal error messages and a RETURN 
without any computation. 


3. Algorithm Usage 


3.1 User Interface. The input to ADAPT is via the COMMON block INPUTZ 
except for the function F. This is the most convenient for extensive use of ADAPT 
but not for occasional use. A subroutine PPFIT4 is provided which has all input as 
arguments. Entry points PPFIT1, PPFIT2, and PPFIT3 in PPFIT4 have fewer 
(10, 12, 15, respectively) arguments than PPFIT4 (21 arguments). Due to the 
variable nature of entry point implementations, these are only indicated by COM- 
MENT cards and local modifications are needed to activate these features. 

The basic output is the arrays XKNOTS and COEFS which are arguments to 
ADAPT (and also the PPFIT subroutines) and the numbers KNOTS and ERROR 
in the COMMON block RESULZ. The PPFIT routines have KNOTS and ERROR 
as arguments. In addition the FUNCTION subprogram PPOLY (T, XKNOTS, 
COEFS, KDIMEN, NDIMEN) returns the value at the point T of the most 
recently computed approximation. It is automatically available to the user. 

There are six levels (—1, 0, 1, 2, 3, 4) of printed output available. LEVEL = —1 
only provides fatal error messages; LEVEL = 0 also provides ‘“‘semifatal’’ error 
messages plus 1 line of output; LEVEL = 1 provides a printout of the input and 
the approximation obtained; LEVEL = 2 provides a condensed trace of the com- 
putation and the last two levels are only useful for debugging program modifica- 
tions. 

3.2 The Characteristic Length of F, CHARF. The correct operation of ADAPT 
depends on certain estimates being accurate which, in turn, depend on the relevant 
subintervals being small enough. Specifically, the sampling that ADAPT does of 
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T° must reveal the nature of I* and not allow any significant features to go unde- 
tected. The nature of ADAPT is such that for reasonable functions it is very un- 
likely to miss significant features without using CHARF at all. However, knowing 
how ADAPT works, one can readily construct examples where it will fail unless 
CHARF is set properly. The value of CHARI is an upper limit on the size of the 
subintervals for polynomial pieces and it is to be set so that the 4-point Gauss 
quadrature formulas are reasonably (but not highly) accurate. This means that if 
I’ has some complex behavior on a very short segment, then setting CHARF 
to, say, half the length of this segment will foree ADAPT to detect this behavior. 

The argument CHARI is essential to proving ADAPT correct (which has not 
been attempted) but its practical value is debatable. If F is more or less uniformly 
complicated then short intervals are needed everywhere. It is extremely unlikely, 
but not impossible, that ADAPT would be fooled in sucha case. If F is very smooth 
except on a very short segment, then ADAPT may well be fooled and setting 
CHARE small will avoid this. However, it will also force very small intervals where 
1° is smooth and where they are not needed. Thus high reliability is obtained here 
at the cost of great inefficiency. 

The nature of the approximations computed by ADAPT are such that there is a 
simple and efficient alternative to setting CHARI small. Let [C,D] be the sub- 
interval of [A,B] where I is rough and let I be smooth elsewhere. One can then 
approximate I’ on [A,C], [C,D], and [D,B] independently, and the approximations 
fit together smoothly at C and D to give a single smooth approximation for the 
entire interval [A,B]. 

3.3 The Error Distribution Type, EDIST. The least squares error for the ap- 
proximation S(x) to F(x) is 


(A,B) = [Ja FP(x) — S(x))? dx}. 


To make E(A,B) < .01 is equivalent to making E(A,B)? < .0001, and for any 
Lp-norm the program actually operates with ACCUR”. Suppose A=0, B=1, then 
we can achieve E(0,1)? < .0001 by achieving E(0,1/2)? < .0001/2 and E(1/2, 1)? 
< .0001/2 since E(A,B)? is simply additive over intervals. This approach is called 
proportional error distribution, i.e. the total error requirement is distributed over 
the subintervals of [A,B] in proportion to the lengths of the subintervals. This 
choice is sclected by KDIST=0 and automatically results in the total error 
IX(A,B)? less than the specified error ACCUR?. 

An alternative approach is to make the errors approximately equal on each of 
the subintervals independent of their lengths. This is called fixed error distribution 
and is selected by EDIST =2. The argument ACCUR is used for each subinterval 
and if k subintervals are finally used we see that the total error is then 


[k x ACCUR?]” = P4/(k) ACCUR 


and thus ACCUR is not the specified total error when EDIST=2. This alterna- 
tive is awkward to use because the final approximation error depends on the num- 
ber of subintervals required which, of course, is unknown until after the approxi- 
mation is computed. However, for rough or singular I*(x) this disadvantage is more 
than compensated by the superior performance of this error distribution type. 
This is seen in the theory and verified in actual use. 

A compromise approach called approximate fixed error distribution is selected by 
EDIST=1. Basically the algorithm keeps a running estimate of the final number 
of intervals it will use and adjusts the error requirement for subintervals accordingly. 
This approach is obviously not foolproof, but the testing reported below shows it 
to be 98 to 99 percent reliable. In any case, the total error actually obtained is 
available for the user to see and to test. For smooth, uniformly varying F(x) the 
proportional error distribution gives perfectly satisfactory efficiency. 

We observe that for p = infinity (NORM=3) there is no difference between 
the fixed and proportional error distributions. 
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3.4 Portability Considerations. Considerable pains have been taken to make the 
Fortran program portable. It is written in a subset of ANSI Fortran specified by 
PFORT (see [5]) except that four characters are packed per word rather than 
one as specified by PFORT. The current version is in single precision and specifi- 
cally tailored to a machine with a long word length (CDC 6000-7000 series com- 
puters). Specific directions are given in the comments for changing the precision 
or to use it-on machines with a shorter word length. In particular, all REAL vari- 
ables are explicitly declared to facilitate the change to DOUBLE PRECISION. 
The program has been gencrated by an experimental Fortran converter which 
automatically produces versions tailored for different machines and precisions. 
Several of these versions have been produced and run successfully. 


4. Algorithm Testing and Verification 


This algorithm is based on a method with theoretically known properties. Care was 
taken to adhere to the requirements of that theory and considerable analysis has 
been made of various features and parts of the algorithm. However, no formal proof 
has been attempted since, as with many numerical algorithms, one cannot say a 
priori what is to be computed. A somewhat related algorithm has been proved 
correct with a few idealizing assumptions (infinite precision arithmetic and infinite 
memory, for example); see [8, 4]. 

Very extensive testing of the algorithm has been performed to see if the theo- 
retical expectations are, in fact, realized by this algorithm. There are some approxi- 
mation methods where this has not been the case. These tests are discussed at some 
length in [2] and we summarize them by saying that this algorithm performs as 
expected from the theory. The results in [2] give many insights into the practical 
use of this algorithm. About 2500 to 3000 different approximations have been com- 
puted in these tests and all have been examined for signs of incorrect performance. 
A few hundred of these runs were specifically designed to test the validity and cor- 
rectness of the program. : 

The code with the ADAPT includes a set of 20 test functions (10 of them parame- 
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Fig. 1. The complicated function with seven pieces approximated in the second example 
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terized in various ways) and a driver to exercise ADAPT and measure its perfor- 
mance in various ways. These are included because it is felt they will be useful for 
testing other function approximation programs. We note that the 20 test functions 
are chosen to present various features of the approximation problem and we found 
it amazingly difficult to get the first few derivatives of these functions computed 
correctly. 

We give sample output for two functions, one easy and one difficult. The first 
is F(x) = 1./4+(x—2.5)*) with LEVEL=2 output given. The second function 
is shown in Figure 1 with LEVEL = 0 output given. In the first example the first 
and last three lines of output are from the test driver and the specific information 
about the problem is printed by ADAPT. For the second example the approxima- 
tion is on [2,15] for polynomial degree 6 with 1 continuous derivative; the requested 
and estimated accuracies are .001 and .00057 in the minimax norm; proportional 
error distribution was used with CHARI*=4. This example is function 18 of the 
set of test functions and one of its parameters, P8F, has been set to 1.6 here in- 
stead of 0.6 as given in the DATA for F(x). The output has been reformatted to 
accommodate the narrowed page width here. 


«444A DAPT FOR FUNCTION 4 = HUMP AT 2.5 RECIPROCAL OF QUARTIC 
PIECEWISE POLYNOMIAL APPROXIMATION ON INTERVAL 1.0000E+00 5.0000E-+00 
OF DEGREE 5 WITH 2 CONTINUOUS DERIVATIVES 

ACCURACY REQUESTED IS 1.0000E—03 MEASURED BY LEAST SQUARES 
OTHER INPUT/DEFAULT VARIABLES ARE FOSCIL = 4.0000E+00 

EMEAS = 2.0000E+00 ---- PROPORTIONAL ERROR DISTRIBUTION 

KNOT 2 AT 1.50000E+00, LOCAL—GLOBAL ERRORS = 2.6008E—09 5.0998E—05 
KNOT 3 AT 2.00000E+00, LOCAL—GLOBAL ERRORS = 3.5626H—08 1.9552E—04 
KNOT 4 AT 2.50000E+00, LOCAL—GLOBAL ERRORS = 2.5115E—08 2.5168E—04 
KNOT 5 AT 3.00000E+00, LOCAL—GLOBAL ERRORS = 2.5115E—08 2.9742E—04 
KNOT 6 AT 3.50000E+00, LOCAL—GLOBAL ERRORS = 3.5626H—08 3.5225H—04 
KNOT 7 AT 4.00000E+00, LOCAL—GLOBAL ERRORS = 2.6008E—09 3.5593E—04 
KNOT 8 AT 5.00000E+00, LOCAL—GLOBAL ERRORS = 2.4834E—09 3.5940E—04 


--- ADAPTIVE PIECEWISE POLYNOMIAL APPROXIMATION OF DEGREE 5 WITH 
2 CONTINUOUS DERIVATIVES NEEDED 8 KNOTS FOR ERROR = 3.5940E—04 
KNOT LOCATION X-POWER COEFFICIENTS RELATIVE TO KNOT LOCA- 
TIONS 

1 1.0000000000001 +00 1.649484536082E —01 

3.673078966947E—01 

4.506148423367E—01 

2.850451366482E —01 

5.027123624777E—01 

— 9.058008728205E —01 

2 1.500000000000E-+00 5.000000000000K —01 

1.000000000000E-+-00 

5.000000000000E —01 

— 1.032973743131E-++-00 

— 2.117239975575E-+00 

2.484021982495E-+00 

3 2.000000000000E-+00 9.411764705882E—01 

4.429065743945E —01 

—1.120293099939E-+-00 

7.978831671079E—01 

7.848565031541E —01 

— 1.003053124363E-+-00 
4 2.500000000000E +-00 1.0000000000001-+-00 
0 
0 
1.400366374921E—01 
—1.722776307754E+-00 
1.003053124363HK-+00 
5 3.000000000000E+-00 9.411764705882E—01 
—4.429065743945E —01 
—1.120293099939E +00 
—9.426012619580E —01 
4.092814980663E-+-00 
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— 2.484021982495E-+00 

6 3.500000000000E-+-00 5.000000000000EK —01 
— 1.000000000000E-+-00 

5.000000000000E —01 

9.740323204476E—01 

— 1.761789819574E-+-00 

9.058008728205E —01 

7 4.000000000000E-+-00 1.649484536082E —01 
—3.678078966947E —01 

4,506148423367E—01 

—3.547233211608E—01 

1.658371414434h—01 

—3.440822109296E —02 


ADAPT USED 117 FUNCTION VALUES FOR ERRORS 
SPECIFIED = 1.00000E—03 ESTIMATED BY ADAPT = 3.59399E—04 
INDEPENDENT CHECK = 3.05041E—04 TIME USED = .17200 SECONDS 


***kk+ ADAPT FOR FUNCTION 18 = COMPLICATED FUNCTION WITH 7 PIECES 
os ADAPTIVE PIECEWISE POLYNOMIAL APPROXIMATION OF DEGREE 6 WITH 
1 CONTINUOUS DERIVATIVES NEEDED 30 KNOTS FOR ERROR = 5.7301E—04 

5. High Level Expression of the Algorithm ADAPT 


The following description of ADAPT indicates its basic structure and methods of 
computation: 


PROCEDURE PPFIT — WITH ARGUMENTS = 


F FUNCTION TO FIT LEVEL OUTPUT LEVEL —1 TO 2 

A,B INTERVAL ENDPTS CHARF LIMIT ON PIECES LENGTH 

ACCUR ACCURACY DESIRED EDIST TYPE OF ERROR CONTROL 

DEGREE .POLYNOMIALDEGREE NBREAK .NUMBER OF SPECIFIED 

SMOOTH .NO. CONT. DERIVS BREAK POINTS IN FIT. 

NORM MEAS. OF L—P ERROR HAS RELATED ARGUMENTS 

UP IN (0, INFINITY) GIVING DETAILS. 

OUTPUT = KNOTS. -NUMBER OF KNOTS 
ERROR. ERROR ACHIEVED 
XKNOTS(K),K=1 TO KNOTS KNOT LOCATIONS 
COEFS(K,N),K=1 TO KNOTS POWER COEF. RELATIVE 


N=1 TO DEGREE+1 .TO THE KNOT LOCATIONS 


+*% THIS PROGRAM MERELY COMPUTES A FEW DEFAULT VALUES 
AND PUTS VARIABLES IN COMMON BLOCKS, ETC 


CALL ADAPT — TO DO THE APPROXIMATION 
END PPFIT 
SUBPROGRAM ADAPT 
CALL SETUP — CHECK INPUT, INITIALIZE THINGS, PRINT PROBLEM 


x** LOOP OVER PROCESSING INTERVALS ««« 


CALL TAKE - AN INTERVAL OFF THE STACK 

CALL COMPUT — AN APPROX ON THIS INTERVAL 

CALL CHECK -- FOR DISCARDING OR DIVIDING INTERVAL 

CALL PUT -— NEW INTERVALS ON STACK, UPDATE ALGORITHM STATUS 
CALL TERMIN -— TEST FOR FINISH, PRINT INTERMEDIATE OUTPUT 

IF NOT FINISHED — REPEAT LOOP 


CALL SUMMARY — FOR FINAL OUTPUT 
END ADAPT 


SUBPROGRAM SETUP 
SET LIMITS ON COMPUTATION PARAMETERS 
CHECK ALL INPUT DATA 
INITIALIZE VARIABLES AND INTERVAL STACK 
PRINT PROBLEM STATEMENT 

END SETUP 


SUBPROGRAM TAKE 
CHECK FOR BREAK POINT IN TOP INTERVAL 


525-P 7- 


0 


COLLECTED ALGORITHMS (cont.) 525-P 8- 0 


IF SO — ADJUST XKNOTS TO MAKE IT A PARTITION POINT 
{LSE — DO NOTHING 
END TAKE 


SUBPROGRAM PUT 
CHECK FOR DISCARDING INTERVAL 
IF SO — UPDATE ERROR ESTIMATE 
ADJUST STACK 
CALL PTRANS — TO OBTAIN COEFS FOR THIS INTERVAL 
UPDATE XKNOTS AND COEFS 
MLSE — SUBDIVIDE INTERVAL AND PLACI 2 NEW ONES ON STACK 
CHECK FOR EXCEEDING MAX STACK SIZE OR OBTAINING 
AN INTERVAL WHICH IS TOO SHORT. SUCH SHORT INTERVALS 
ARE DISCARDED WITHOUT REGARD TO ERROR CONTROL POLICY 
AND WITH MESSAGE 
END PUT 


SUBPROGRAM PTRANS — OF PUT 
CHANGES POLYNOMIAL REPRESENTATION FROM NEWTON DIVIDED 
DIFFERENCE FORM TO POWER FORM WITH ORIGIN SHIFTED TO THE 
XKNOT VALUE ON LEFT OF INTERVAL. USES SYNTHETIC DIVISION 

IKND PTRANS 


SUBPROGRAM COMPUT 
OBTAIN — VALUES OF F AND DERIVATIVES. MAKE ADJUSTMENTS 
IF A BREAK POINT IS INVOLVED 
CALL NEWTON — FOR DIVIDED DIFFERENCES OF INTERPOLATING 
POLYNOMIAL FOR THIS INTERVAL 
CALL ERRINT — TO ESTIMATE LOCAL ERROR + (F(X)—POLYDD(X))+##«P 
FOR L—P NORM, 0 LT P LE INFINITY 
END COMPUT 


SUBPROGRAM NEWTON — OF COMPUT 
BUILD UP TRUE DIVIDED DIFFERENCE TABLE WITH MULTIPLE POINTS 
AT THE INTERVAL ENDS PLUS INTERPOLATION POINTS 

END NEWTON 


SUBFUNCTION POLYDD — OF COMPUT 
EVALUATES POLYNOMIAL FROM DIFFERENCE TABLE OUT OF NEWTON 
FOR L—P NORM WITH PIN (0, INFINITY) 
END POLYDD 


SUBPROGRAM ERRINT — OF COMPUT 
USES 4-POINT GAUSS QUADRATURE TO ESTIMATE ERROR NORM ON 
INTERVAL. SPECIAL COMPUTATION FOR MAX—NORM, ‘'P=INFINITY. 
END ERRINT 


SUBPROGRAM CHECK 
USES ERROR DISTRIBUTION TYPE AND CHARF TO DECIDE ON DISCARD 


END CHECK 


SUBPROGRAM TERMIN 
PRINT — INTERMEDIATE OUTPUT, IF ANY REQUESTED BY LEVEL = 2 
TEST — FOR TERMINATION EMPTY STACK — NORMAL 
EXCEEDED XKNOTS LIMIT — ABNORMAL 
KND TERMIN 


SUBPROGRAM SUMMARY 
= 0 1LINE (OUTPUT RETURNED IN COMMON, ARGUMENTS) 
= 1 KNOTS AND COEFFICIENTS 
= 2 DITTO 

END SUMMARY 


FUNCTION PPOLY 
THE PIECEWISE POLYNOMIAL COMPUTED BY PREVIOUS CALL ON PPFIT 
END PPOLY 
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ALGORITHM 


[The listing printed here is an abridged version of the complete algorithm, which is 
available upon request from the ACM Algorithms Distribution Service] 


NNAANN ANN ANAANANDAAAAANAAANANAANANQAANNANAMAAANDANAANANAANAANNANANANANAARANGAANRNANAANAAANAAAANON 


SUBROUTINE ADAPT(F, XKNOTS, COEFS, KDIMEN, NDIMEN) ADA A 
ADA 2 

THIS ALGORITHM COMPUTES A PIECEWISE POLYNOMIAL APPROXIMATION ADA 30 

OF SPECIFIED SMOOTHNESS, ACCURACY AND DEGREE. THE INPUT TO THE ADA 4@ 

COMPUTATION IS ADA 5@ 

ADA 6@ 

F - FUNCTION BEING APPROXIMATED. IT MUST PROVIDE VALUES OF ADA 70 


DERIVATIVES UP TO THE ORDER OF SMOOTHNESS SPECIFIED FOR ADA 8@ 
THE APPROXIMATION. THE CALLING SEQUENCE IS F(X,FDERV) AND ADA 9@ 


FDERV CONTAINS THE DERIVATIVES( SEE CONSTRAINT BELOW) ADA 14¢ 

A,B - THE ENDPOINTS OF THE INTERVAL OF APPROXIMATION ADA 11 
ACCUR - THE ACCURACY REQUIRED FOR THE APPROXIMATION ADA 12@ 
SMOOTH - THE SMOOTHNESS REQUIRED FOR THE APPROXIMATION ADA 130 
= ¢ MEANS CONTINUOUS ADA 14¢ 

= 1 MEANS CONTINUOUS SLOPE ADA 15¢ 

= 2 MEANS CONTINUOUS SECOND DERIVATIVE, ETC. ADA 16¢ 

DEGREE ~- THE DEGREE OF THE POLYNOMIAL PIECES. ADA 170 
MUST HAVE DEGREE GT 2*SMOOTH ADA 18¢ 

ADA 19¢ 


kARKK HK SECONDARY INPUT ~ ITEMS WITH DEFAULT VALUES POSSIBLE ADA 20@ 
CHARF -— CHARACTERISTIC LENGTH OF THE FUNCTION F(X). PIECES ARE NOT ADA 210 


LONGER THAN THIS LENGTH. ADA 22 
DEFAULT=(B-A) IF DEGREE GT 1, ELSE (B-A)/3 ADA 23¢ 

NORM -— NORM TO MEASURE THE APPROXIMATION ERROR ADA 24¢ 
= 1 Ll APPROXIMATION (LEAST DEVIATIONS) ADA 25¢ 

= 2 L2 APPROXIMATION (LEAST SQUARES) ADA 26¢ 

= 3 TCHEBYCHEFF (MINIMAX) APPROXIMATION ADA 27¢@ 

=-P (NEGATIVE VALUE) GENERAL LP APPROXIMATION ADA 28¢@ 

DEFAULT= 2 ADA 290 

NBREAK - NUMBER OF SPECIAL BREAK POINTS IN THE APPROXIMATION. ADA 36¢ 
ASSOCIATED INPUT VARIABLES ARE ADA 319 
XBREAK(J) - LOCATION OF BREAK POINTS ADA 320 

DBREAK(J) -—- DERIVATIVE BROKEN AT XBREAK ADA 330 

BLEFT (J)  - VALUE FROM LEFT FOR DBREAK DERIVATIVE ADA 34 

BRIGHT(J) - - - RIGHT - - - ADA 35¢ 

DEFAULT = @ ADA 36 

LEVEL —- LEVEL OF OUTPUT FROM ADAPT ADA 37¢ 
= -1 NO OUTPUT AT ALL EXCEPT FOR FATAL INPUT ERRORS ADA 38¢ 

= @ ERROR CONDITIONS NOTED, FINAL SUMMARY ADA 399 

= 1 PRINT THE APPROXIMATION OUT ADA 4¢¢ 

= 2 DETAILS OF THE COMPUTATION ADA 41¢ 

= 3 DEBUG OUTPUT, = 4 LOTS OF DEBUG OUTPUT ADA 42¢ 

DEFAULT = @ ADA 43 

EDIST - SWITCH TO CHANGE FROM PROPORTIONAL ERROR DISTRIBUTION ADA 44¢ 
TO FIXED DISTRIBUTION. THIS IS PRIMARILY OF USE IN ADA 45¢ 
APPROXIMATION OF FUNCTIONS WITH SINGULARITIES. ONE SHOULD ADA 46¢ 

USE NORM = 1. OR SO IN SUCH CASES ADA 47¢ 

= @ PROPORTIONAL DISTRIBUTION ADA 48¢@ 

= 1 APPROXIMATE FIXED ERROR DISTRIBUTION ADA 49¢ 

ATTEMPTS TO ACHIEVE SPECIFIED ACCURACY VALUE ACCUR ADA 50 

= 2 TRUE FIXED ERROR DISTRIBUTION ADA 51@ 

ADA 52¢ 

THE OUTPUT OF THE COMPUTATION CONSISTS OF 3 PARTS, EACH RETURNED ADA 53¢@ 
TO THE USER IN A DIFFERENT WAY. THEY ARE ADA 540 
ADA 55¢@ 

XKNOTS,COEFS - ARRAYS DEFINING THE PIECEWISE POLYNOMIAL RESULT. ADA 56¢ 


XKNOTS(K) = KNOTS OF THE APPROXIMATION ( K = 1 TO KNOTS) ADA 576 
THE LAST ONE IS RIGHT END POINT OF INTERVAL ADA 580 
COEFS(K,N) = COEFFICIENT OF (X - XKNOT(K))**(N-1) IN THE ADA 59¢ 
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Cc INTERVAL XKNOT(K) TO XKNOT(K+1) ADA 60¢ 
C K = 1 TO KNOTS-1 AND N = 1 TO DEGREE+1 ADA 61 
Cc THESE ARRAYS ARE PASSED AS ARGUMENTS SO AS TO USE VARIABLE ADA 62¢ 
Cc DIMENSIONS. ADA 63¢ 
C KDIMEN - DIMENSION USED FOR XKNOTS IN CALLING PROGRAM ADA 64¢@ 
Cc NDIMEN - COEFS IS DECLARED COEFS(KDIMEN,NDIMEN) IN THE ADA 65¢@ 
C CALLING PROGRAM. ADA 66¢ 
Cc kkREK NOTE ***%% SEVERAL SMALL ARRAYS HERE HAVE FIXED ADA 67@ 
Cc DIMENSIONS THAT LIMIT DEGREE AND THUS NDIMEN ADA 68¢ 
Cc SHOULD NOT EXCEED THIS LIMIT (CURRENTLY = 12) ADA 69¢ 
Cc ADA 70¢ 
C PPOLY - THE PIECEWISE POLYNOMIAL APPROXIMATING FUNCTION. ADA 71¢ 
c THIS FUNCTION SUBPROGRAM IS AVAILABLE TO THE USER AT THE ADA 720 
Cc COMPLETION OF ADAPT. ADA 73¢ 
Cc ADA 74¢ 
C  RESULZ - A LABELED COMMON BLOCK WITH ERROR,KNOTS IN IT ADA 75¢ 
Cc KNOTS - NUMBER OF KNOTS OF PPOLY ADA 76¢ 
Cc ERROR — ACCURACY OF PPOLY AS ESTIMATED BY ADAPT ADA 779 
Cc ADA 786 
C xkkkKAKKKK DIMENSION CONSTRAINTS *&*&ek4eKX ADA 790 
Cc MAXKNT - MAX NUMBER OF KNOTS TAKEN FROM USER VIA KDIMEN ADA 80¢ 
G ARRAYS WITH THIS DIMENSION ADA 81¢@ 
Cc COEFS XKNOTS ADA 82¢ 
C MAXPAR — MAX NUMBER OF PARAMETERS PER INTERVAL ( = 12 CURRENTLY ) ADA 83¢@ 
Cc USER PROVIDED NDIMEN MUST HAVE NDIMEN LE MAXPAR ADA 84¢ 
c MUST HAVE DEGREE + 1 LE MAXPAR ADA 85¢@ 
C ARRAYS WITH THIS DIMENSION (OR RELATED VALUES ) ADA 86¢@ 
Cc D '  DDTEMP FDERVL FDERVR FDUMB FACTOR ADA 87¢ 
Cc FINTRP FLEFT FRIGHT POWERS XTEMP XINTRP XDD ADA 889 
C kkKKK NOTE **%*% MAXPAR ALSO AFFECTS ARGUMENT FDERV ADA 89¢ 
Cc OF FUNCTION F. FDERVL, FDERVR ARE ALSO INVOLVED. ADA 960 
Cc SHOULD DECLARE FDERV OF SIZE 6 IN F TO BE SAFE. ADA 91¢ 
C MAXAUX - MAXIMUM NUMBBER OF AUXILIARY INPUT( = 26 NOW ). ARRAYS ADA 92¢ 
cC XBREAK DBREAK BLEFT BRIGHT ADA 93 
C MAXSTK ~ MAX SIZE OF ACTIVE INTERVAL STACK ADA 94¢ 
Cc MIN INTERVAL LENGTH IS 2**(-MAXSTK)*(B-A). ARRAYS ADA 95¢ 
Cc XLEFT XRIGHT ADA 96¢ 
C ADA 97¢ 
C kkkkKAKEKK PORTABILITY CONSIDERATIONS *&*keekKKK ADA 98¢ 
Cc ADA 996 
Cc THIS PROGRAM IS IN ANSI STANDARD FORTRAN. IN ADDITION, IT MEETS ADA 1666 
C ALL THE REQUIREMENTS OF THE BELL LABS PORTABLE FORTRAN -PFORT- ADA 1416 
Cc EXCEPT ONE. HOLLERITH CHARACTERS ARE PACKED 4/WORD RATHER THAN ADA 162¢ 
Cc 1/WORD AS SPECIFIED BY PFORT. ADA 163¢ 
c NEVERTHELESS, THIS PROGRAM IS AFFECTED IN SEVERAL WAYS BY A ADA 104¢ 
Cc CHANGE IN MACHINE WORD LENGTH AND CHANGING TO DOUBLE PRECISION. ADA 1¢5¢@ 
Cc *kk*K THIS VERSION IS FOR THE MACHINE WITH THE LONGEST SINGLE ADA 106 
Cc PRECISION WORD (CDC). THE LENGTH OF SOME CONSTANTS IN ADA 1067¢ 
Cc THE SUBPROGRAM COMPUT EXCEEDS THE CAPACITY OF SOME FORTRAN ADA 168¢ 
Cc COMPILERS AND CAN PREVENT COMPILATION. ADA 1969¢ 
C INPUT-OUTPUT -- IS OF THREE TYPES. ADA 11060 
Cc FATAL ERROR MESSAGES - OCCUR IN SETUP,TAKE,PUT AND TERMIN ADA 111¢ 
Cc THEY CANNOT BE SWITCHED OFF ADA 112¢ 
G USER AND DEBUGGING OUTPUT - CAN BE SWITCHED OFF ADA 113¢ 
6 THESE INVOLVE MANY FORMATS LIKE E15.8, F12.8, £22.13, ETC. ADA 114¢ 
C SOME FORTRAN COMPILERS REQUIRE D-FORMAT FOR DOUBLE PRECISION. ADA 115¢ 
Cc SOME DO NOT HANDLE E22.13 ON MACHINES OF SHORTER WORD LENGTH. ADA 116¢ 
Cc ADA 117¢ 
c SUMARY PRINTS COEFFICIENTS 5 PER LINE, 6 PER LINE IS BETTER ADA 118¢ 
Cc FOR SHORTER WORD LENGTHS. DOUBLE PRECISION ON MANY MACHINES ADA 1199 
Cc LIMITS ONE TO 4 PER LINE. ADA 12¢¢ 
¢ ADA 121¢ 
C CONSTANTS -- THE GAUSS WEIGHTS AND ABSCISSA IN COMPUTE ARE GIVEN ADA 122¢ 
Cc TO 15 DIGITS IN THE COMMENTS ADA 123¢ 
Cc ADA 1240 
C DOUBLE PRECISION CONVERSION -- KEQUIRES FOUR STEPS ADA 125¢ 
Cc 1. ALL REAL VARIABLES ARE DECLARED DOUBLE PRECISION. THIS IS ADA 126¢ 
Cc DONE BY CHANGING REAL TO DOUBLE PRECISION AS ALL REALS ARE ADA 1276 
C EXPLICITLY DECLARED AND ROOM IS LEFT FOR THIS CHANGE. REAL ADA 128¢ 
G VARIABLES APPEAR BEFORE INTEGERS IN ALL COMMON BLOCKS. ADA 1290 
Cc ADA 1300 
Cc 2. ADD D TO CONSTANTS( E.G. 1.6 = 1.@D@ ). ADJUST LENGTH OF ADA 131¢ 
C GAUSS WEIGHTS IN COMPUTE. ADA 1320 
c ADA 133@ 
C 3. CHANGE ABS,AMAX1,FLOAT AT MANY PLACES ADA 134 
Cc ADA 135¢ 


COLLECTED ALGORITHMS (cont.) 
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4, ADJUST THE INTERVAL STACK SIZE = DIMENSIONS OF XLEFT, XRIGHT 
AND VALUE OF MAXSTK. ADJUST THE VALUE BUFFER IN PUT TO BE 
ABOUT .1E-K FOR A MACHINE WITH K+2 DECIMAL DIGITS. 


REAL A, ACCLUR, B, BLEFT, BRIGHT, CHARF, DDTEMP, DSCTOL, ERROR, 
* ERRORZI, FACTOR, FINTRP, FLEFT, FRIGHT, NORM, XBREAK, XDD, 
* XINTRP, XLEFT, XRIGHT 

DIMENSION XBREAK(20), DBREAK(2@), BLEFT(2@), BRIGHT (2) 

DIMENSION XLEFT(5@), XRIGHT(5@), FACTOR(12), FMESGE(6) 

DIMENSION DDTEMP(12,12), FINTRP(10), FLEFT(6), FRIGHT(6), 
* XDD(12), XINTRP(1@) 

INTEGER BOTH, BREAK, DBREAK, DEGREE, EDIST, FMESGE, RIGHT, 
* RIGHTX, SMOOTH 

LOGICAL DISCRD, FATAL, FINISH 

REAL XKNOTS (KDIMEN), COEFS (KDIMEN, NDIMEN) 

EXTERNAL F 

REAL F 


COMMON /INPUTZ/ A, B, ACCUR, NORM, CHARF, XBREAK, BLEFT, BRIGHT, 

* DBREAK, DEGREE, SMOOTH, LEVEL, EDIST, NBREAK, KNTDIM, NPARDM 
KNTIDIM - KDIMEN, NAME CHANGED TO PUT IN COMMON 
NPARDM - NDIMEN, NAME CHANGED TO PUT IN COMMON 

COMMON /RESULZ/ ERROR, KNOTS 
KNOTS = FINAL NO. OF KNOTS, INCLUDES B AS ONE. 
ERROR = ESTIMATE OF ERROR ACTUALLY ACHIEVED. 

COMMON /KONTRL/ DSCTOL, ERRORI, XLEFT, XRIGHT, BREAK, BOTH, 

* FACTOR, FMESGE, IBREAK, INTERP, LEFT, MAXAUX, MAXKNT, MAXPAR, 

* MAXSTK, NPAR, NSTACK, RIGHT, DISCRD, FATAL, FINISH 

KONTRL CONTAINS GENERALLY USEFUL VARIABLES 

FATAL - SWITCH FOR DETECTION OF FATAL ERROR 


ADA 


INCLUDING EXCESSIVE INTERVAL SUBDIVISIONADA 
WHICH DOES NOT TERMINATE THE COMPUTATIONADA 


FINISH - SWITCH TO TERMINATE ALGORITHM 
MAXS - SEE COMMENTS EARLIER 


ADA 
ADA 


NSTACK - COUNTER FOR INTERVAL STACK, CONSISTS OF ADA 


(XLEFT (J) ,XRIGHT(J)) J = 1 TO NSTACK 
ERRORI - ERROR ESTIMATE FOR TOP INTERVAL 


ADA 
ADA 


DSCTOL - TOLERANCE TO CHECK DISCARDING INTERVALS ADA 
DISCRD — SWITCH TO SIGNAL DISCARD OF TOP INTERVALADA 


FACTOR - ARRAY OF FACTORIALS 
NPAR - NUMBER OF PAREMETERS = DEGREE + 1 
FMESGE - STRING = ***%* FATAL ERROR ***** 


INTERP - NUMBER OF INTERIOR INTERPOLATION POINTS 


IN THE NORMAL INTERVAL 
IBREAK - COUNTER ON BREAK POINTS 
BREAK - SWITCH FOR BREAK POINT IN TOP INTERVAL 


iy = NO BREAK PRESENT 

LEFT = BREAK AT XLEFT(NSTACK) 
RIGHT = BREAK AT XRIGHT(NSTACK) 
BOTH = BREAK AT BOTH ENDS 


COMMON /COMDIF/ DDTEMP, FINTRP, FLEFT, FRIGHT, XDD, XINTRP, 
* LEFTX, NINTRP, RIGHTX 


COMDIF CONTAINS VARIABLES USED ONLY BY COMPUT AND FRIENDS .ADA 
NINTRP - NUMBER OF INTERIOR INTERPOLATION POINTS ADA 


FOR THE CURRENT INTERVAL 

XINTRP - INTERIOR INTERPOLATION POINTS 

FINTRP -— F VALUES AT XINTRP POINTS 

LEFTX —- MULTIPLICITY OF INTERPOLATION AT XLEFT 
= NO. OF DERIVATIVES MATCHED AT XLEFT 


ADA 


FLEFT - VALUES OF F AND ITS DERIVATIVES AT XLEFTADA 
RIGHTX - MULTIPLICITY OF INTERPOLATION AT XRIGHT ADA 


FRIGHT - VALUES OF F AND DERIVATIVES AT XRIGHT 
DDTEMP - THE ARRAY OF DIVIDED DIFFERENCES 
XDD - THE X VALUES FOR DDTEMP WITH PROPER 
MULTIPLICITIES OF XLEFT AND XRIGHT 
COMMON /SAVEIT/ IKNOT 


*xk*K NOTE - ARGUMENTS BELOW ARE FOR READABILITY ONLY RRAKK 
RARKK EXCEPT FOR F AND XKNOTS,COEFS,KDIMEN,NDIMEN ***** 


CHECK INPUT, INITIAL COMPUTATIONS, PRINT PROBLEM 
CALL SETUP(XKNOTS, COEFS, KDIMEN, NDIMEN) 


CHECK FOR FATAL ERROR IN PROBLEM SPECIFICATION 
IF (FATAL) RETURN 


ADA 


1360 
1370 
1380 
1399 
140¢ 
141¢ 
142¢ 
1430 
1446 
145¢ 
1460 
147¢ 
148¢ 
149¢ 
1500 
151¢ 
1520 
1530 
1546 
155¢ 
156¢ 
157@ 
158¢ 
1590 
1600 
1616 
1620 
1630 
164¢ 
165@ 
1660 
167¢ 
168¢ 
169¢ 
176¢ 
171¢ 
1720 
1730 
174¢ 
175¢ 
176¢ 
177¢ 
178¢ 
179¢ 
18¢¢ 
181¢ 
182¢ 
183¢ 
184@ 
185¢ 
186¢ 
187¢ 
188¢ 
189¢ 
190¢ 
191¢ 
192¢ 
1930 
1940 
195¢ 
1960 
1970 
1980 
199¢ 
20060 
2610 
2020 
2030 
2040 
205¢ 
206¢ 
2076 
2080 
2090 
2106¢ 
2110 
212¢ 
2136 
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C 
C 


c 


Cc 
Cc 


C 
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LOOP OVER PROCESSING OF INTERVALS 


16 CALL TAKE (INTERV) 


HK 


CALL COMPUT(F, APPROX, INTERV) 


CHECK FOR DISCARDING INTERVALS 
CALL CHECK(FUNCT, CHARCT) 


PUT NEW INTERVALS ON STACK OR DISCARD, UPDATE STATUS 
CALL PUT(INTERV, XKNOTS, COEFS, KDIMEN, NDIMEN) 


CALL TERMIN(TEST, AND, PRINT, XKNOTS, KDIMEN) 
IF (.NOT.FINISH) GO TO 1¢ 
CALL SUMARY(XKNOTS, COEFS, KDIMEN, NDIMEN) 


RETURN 
END 


SUBROUTINE PPFIT4(F, XLFT, XRGT, EPSLN, NPIECE, ERREST, XKNOTS, 
* COEFS, KDIMEN, NDIMEN, NDEG, NSMTH, EMEAS, LPRNT, FOSCIL, ATYPE, 


* KBREAK, BRAKPT, KDERVB, VALLFT, VALRGT) 


PPF 


SE oR SSeS SP esc SSS Ke SSS es eS HSS SH STL eS se S SS ees HSS Ss SSE L==PPK 


PPF 


THIS SET OF FOUR CONTROL PROGRAMS SET VARYING NUMBERS OF DEFAULT PPF 


VALUES FOR ARGUMENTS. IT USES ENTRY STATEMENTS WHICH ARE DONE 


PPF 


DIFFERENTLY BY VARIOUS FORTRANS. FOR THIS REASON ENTRY STATEMENTSPPF 


ARE ONLY INDICATED BY COMMENT CARDS. WRITING FOUR SEPARATE ROU- 


TINES APPROXIMATELY TRIPLES THE LENGTH OF THE TOTAL CODE. 


THE FOLLOWING TABULATES THE INTERNAL AND EXTERNAL NAMES OF THE 


ARGUMENTS ALONG WITH THEIR DEFAULT VALUES FOR THE VARIOUS PPFIT. 
NOTE THAT THIS ALLOWS THE ARGUMENTS TO BE PUT INTO A COMMON BLOCK 


AND AVOIDS LONG ARGUMENT LISTS WITHIN ADAPT ITSELF. 


INTERNAL EXTERNAL DEFAULT VALUE SET BY PPFIT NUMBER 
F F NONE 

A,B A,B NONE 

ACCUR EPSLN NONE 

KNOTS NPIECE OUTPUT 

ERROR ERREST OUTPUT 

XKNOTS XKNOTS OUTPUT 

COEFS COEFS OUTPUT 

KDIMEN KDIMEN NONE 

NDIMEN NDIMEN NONE 

DEGREE NDEG 3 1 
SMOOTH NSMTH i) 1 
NORM EMEAS 3 1 2 
LEVEL LPRNT 1 1 2 
CHARF FOSCIL VARIABLE 1 2 
EDIST ATYPE 1 125 
NBREAK KBREAK (4) 123 
XBREAK BRAKPT - 

DBREAK KDERVB = 

BLEFT VALLFT - 

BRIGHT VALRGT - 


REAL A, ACCUR, B, BLEFT, BRIGHT, CHARF, DDTEMP, DSCTOL, ERROR, 
* ERRORI, FACTOR, FINTRP, FLEFT, FRIGHT, NORM, XBREAK, XDD, 
* XINTRP, XLEFT, XRIGHT 

DIMENSION XBREAK(20), DBREAK(2@), BLEFT(2@), BRIGHT (2@) 
DIMENSION XLEFT(5@), XRIGHT(5@), FACTOR(12), FMESGE(6) 
DIMENSION DDTEMP(12,12), FINTRP(10), FLEFT(6), FRIGHT(6), 
* XDD(12), XINTRP(10) 

INTEGER BOTH, BREAK, DBREAK, DEGREE, EDIST, FMESGE, RIGHT, 
* RIGHTX, SMOOTH 

LOGICAL DISCRD, FATAL, FINISH 

REAL XKNOTS(KDIMEN) , COEFS (KDIMEN,NDIMEN) 

REAL BRAKPT, EMEAS, EPSLN, ERREST, FOSCIL, F, VALLFT, VALRGT, 
* XLFT, XRGT 

DIMENSION BRAKPT (20), KDERVB(2@), VALLFT(2@), VALRGT (20) 
INTEGER ATYPE 

EXTERNAL F 


PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPE 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPE 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPE 
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COMMON /INPUTZ/ A, B, ACCUR, NORM, CHARF, XBREAK, BLEFT, BRIGHT, 


* DBREAK, DEGREE, SMOOTH, LEVEL, EDIST, NBREAK, KNIDIM, NPARDM 
COMMON /RESULZ/ ERROR, KNOTS 

COMMON /KONTRL/ DSCTOL, ERRORI, XLEFT, XRIGHT, BREAK, BOTH, 
* FACTOR, FMESGE, IBREAK, INTERP, LEFT, MAXAUX, MAXKNT, MAXPAR, 
* MAXSTK, NPAR, NSTACK, RIGHT, DISCRD, FATAL, FINISH 

COMMON /COMDIF/ DDTEMP, FINTRP, FLEFT, FRIGHT, XDD, XINTRP, 

* LEFTX, NINTRP, RIGHTX 

COMMON /SAVEIT/ IKNOT 


SKIP ALL DEFAULT SETTING FOR PPFIT4 


GO TO 1¢ 


SET DEFAULTS FOR PPFITI1 


kkKKKK SINCE ENTRY IS NON-STANDARD ****%% 
wAAKKE THE NATURAL WAY TO IMPLEMENT ***%*% 
wkAKKE THE OTHER PPFITS IS ONLY REKKKK 
*AAKKE TNDICATED IN THE COMMENTS RERKKE 


ENTRY PPFIT1 
ENTRY PPFIT1(F,XLFT,XRGT,EPSLN,NPIECE, ERREST ,XKNOTS,COEFS, 
A 


KDIMEN , NDIMEN) 


NDEG = 3 
NSMTH = @ 


SET DEFAULTS FOR PPFIT2 


ENTRY PPFIT2 
ENTRY PPFIT2(F,XLFT,XRCT,EPSLN,NPIECE, ERREST ,XKNOTS ,COEFS, 


A 
EMEAS = 3.¢@ 


KDIMEN , NDIMEN , NDEG ,NSMTH) 


LPRNT = 1 

FOSCIL = B-A 

IF (NDEG.EQ.2) FOSCIL = .5*FOSCIL 
IF (NDEG.LE.1) FOSCIL = (B-A)/3. 


SET DEFAULTS FOR PPFIT3 


ENTRY PPFIT3 
ENTRY PPFIT3(F,XLFT,XRGT,EPSLN,NPIECE, ERREST ,XKNOTS ,COEFS, 


A 


KDIMEN, NDIMEN,NDEG , NSMTH, EMEAS , LPRNT , FOSCIL) 


ATYPE = 1 
KSING = @ 
KBREAK = @ 


PUT INPUT INTO COMMON INPUTZ BY CHANGING TO INTERNAL NAMES 


ACCUR = EPSLN 
DEGREE = NDEG 


SMOOTH = NSMTH 
NORM = EMEAS 
LEVEL = LPRNT 
CHARF = FOSCIL 
EDIST = ATYPE 


NBREAK = KBREAK 
IF (NBREAK.LE.@ .OR. NBREAK.GE.21) GO TO 3¢ 
DO 2¢ K=1,NBREAK 
XBREAK(K) = BRAKPT(K) 
DBREAK(K) = KDERVB(K) 
BLEFT(K) = VALLFT(K) 
BRIGHT(K) = VALRGT(K) 
26 CONTINUE 
3@ CONTINUE 


CALL ADAPT(F, XKNOTS, COEFS, KDIMEN, NDIMEN) 
NPIECE = KNOTS 

ERREST = ERROR 

RETURN 


END 


SUBROUTINE CHECK(FUNCT, CHAR) 


PPF 
PPF 
PPF 
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PPF 
PPF 
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PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
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PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
PPF 
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PPF 
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PPF 
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CHE 
CHE 


1¢ 
26 
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THIS PROGRAM CHECKS FOR DISCARDING INTERVAL, APPLIES VARIOUS 
TESTS ABOUT DISCARDING INVOLVING EDIST AND CHARF. 


REAL A, ACCUR, B, BLEFT, BRIGHT, CHARF, DDTEMP, DSCTOL, ERROR, 
* ERRORI, FACTOR, FINTRP, FLEFT, FRIGHT, NORM, XBREAK, XDD, 
* XINTRP, XLEFT, XRIGHT 

DIMENSION XBREAK(2@), DBREAK(20), BLEFT(20), BRIGHT(2@) 
DIMENSION XLEFT(5@), XRIGHT(5@), FACTOR(12), FMESGE(6) 
DIMENSION DDTEMP (12,12), FINTRP(16), FLEFT(6), FRIGHT(6), 
* XDD(12), XINTRP (10) 

INTEGER BOTH, BREAK, DBREAK, DEGREE, EDIST, FMESGE, RIGHT, 
* RIGHTX, SMOOTH 

LOGICAL DISCRD, FATAL, FINISH 

REAL DTEST, DX 


COMMON /INPUTZ/ A, B, ACCUR, NORM, CHARF, XBREAK, BLEFT, BRIGHT, 


* DBREAK, DEGREE, SMOOTH, LEVEL, EDIST, NBREAK, KNTDIM, NPARDM 
COMMON /RESULZ/ ERROR, KNOTS 

COMMON /KONTRL/ DSCTOL, ERRORI, XLEFT, XRIGHT, BREAK, BOTH, 

* FACTOR, FMESGE, IBREAK, INTERP, LEFT, MAXAUX, MAXKNT, MAXPAR, 
* MAXSTK, NPAR, NSTACK, RIGHT, DISCRD, FATAL, FINISH 

COMMON /COMDIF/ DDTEMP, FINTRP, FLEFT, FRIGHT, XDD, XINTRP, 

* LEFTX, NINTRP, RIGHTX 


DISCRD = .FALSE. 
DX = XRIGHT(NSTACK) - XLEFT(NSTACK) 


CHE 


CHE 


COMPUTE DTEST FOR IMPLEMENTING VARIOUS TYPES OF ADAPTIVE APPRXCHE 


IF (EDIST.EQ.@) DTEST = DX*DSCTOL 


CHE 


FOR THE APPROXIMATE FIXED ERROR DISTRIBUTION TYPE WE ESTIMATE ChE 


THE FINAL NUMBER OF KNOTS BY( LIMITING IT A LITTLE ) 
(NSTACK+KNOTS+2) ( (B-A) / (XRIGHT-A) ) 


CHE 
CHE 


IF (EDIST.EQ.1) DTEST = DSCTOL/ (FLOAT (NSTACK+KNOTS+2)*AMIN1 ( (B-A) /CHE 


* (XRIGHT (NSTACK)~A) ,5.)) 
IF (EDIST.EQ.2 .OR. NORM.EQ.3.) DTEST = DSCTOL 


CHECK FOR DISCARD OF INTERVAL 
IF (ERRORI.LE.DTEST) DISCRD = .TRUE. 


CHECK CHARACTERISTIC LENGTH OF FUNCTION 
IF (DX.GE.CHARF) DISCRD = .FALSE,. 
RETURN 


Lab 


SUBROUTINE COMPUT(E, APPROX, INTERV) 


CHE 


COM 
COM 


Sorreccesccer EE cree eee CERES EEE EEE EES CCE eR Eee (MM 


THIS PROGRAM COMPUTES THE PIECEWISE POLYNOMIAL APPROXIMATION ON 
THE CURRENT INTERVAL. IT ALSO ESTIMATES THE ERROR 


REAL A, ACCUR, B, BLEFT, BRIGHT, CHARF, DDTEMP, ISCTOL, ERROR, 
* ERRORI, FACTOR, FINTRP, FLEFT, FRIGHT, NORM, XBREAK, XDD, 
* XINTRP, XLEFT, XRIGHT 

DIMENSION XBREAK(2@), DBREAK(2@), BLEFT(2@), BRIGHT (20) 
DIMENSION XLEFT(5@), XRIGHT(50), FACTOR(12), FMESGE(6) 
DIMENSION DDTEMP(12,12), FINTRP(1@), FLEFT(6), FRIGHT(6), 

* XDD(12), KXINTRP(10) 

INTEGER BOTH, BREAK, DBREAK, DEGREE, EDIST, FMESGE, RIGHT, 

* RIGHTX, SMOOTH 

LOGICAL DISCRD, FATAL, FINISH 

REAL ABSC, DX, ERRINT, F, FDERVL, FDERVR, FDUMB, POLYDD, WGTS 
DIMENSION ABSC(4), WGTS(4), FDERVL(5), FDERVR(5), FDUMB(5) 
EXTERNAL F, POLYDD 

COMMON /INPUTZ/ A, B, ACCUR, NORM, CHARF, XBREAK, BLEFT, BRIGHT, 
* DBREAK, DEGREE, SMOOTH, LEVEL, EDIST, NBREAK, KNTDIM, NPARDM 
COMMON /RESULZ/ ERROR, KNOTS 

COMMON /KONTRL/ DSCTOL, ERRORI, XLEFT, XRIGHT, BREAK, BOTH, 

* FACTOR, FMESGE, IBREAK, INTERP, LEFT, MAXAUX, MAXKNT, MAXPAR, 
* MAXSTK, NPAR, NSTACK, RIGHT, DISCRD, FATAL, FINISH 

COMMON /COMDIF/ DDTEMP, FINTRP, FLEFT, FRIGHT, XDD, XINTRP, 

* LEFTX, NINTRP, RIGHTX 


cOM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
COM 
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16 


2@ FLEFT(1) = F(XLEFT(NSTACK) , FDERVL) 
FRIGHT (1) = F(XRIGHT (NSTACK) , FDERVR) 


3¢ 


40 


5¢ 


60 


79 


* 
* 


EQUIVALENCE (FLEFT(2),FDERVL(1)), (FRIGHT (2) ,FDERVR(1)) 


FIFTEEN DIGIT VALUES FOR THESE GAUSS INTEGRATION CONSTANTS ARE 
.861136311594053 .339981643584856 .347854845137454 .652145154862546 
DATA ABSC(1) /-.861136311594065/ 
DATA ABSC(2) /-.33998104358486/ 


DATA ABSC(3) 
DATA ABSC (4) 
DATA WGTS (1) 
DATA WGTS (2) 
DATA WGTS (3) 
DATA WGTS (4) 


/.339981064358486/ 
/ .861136311594065/ 
/.34785484513745/ 
/.65214515486255/ 
/.65214515486255/ 
/ .34785484513745/ 


COMFUTE INTERPOLATION INFORMATION 
NINTRP = DEGREE - 2*SMOOTH - 1 


INCREASE NUMBER OF INTERPOLATION POINTS IF BREAK POINTS ARE 


SPECIFIED WITH FEWER DERIVATIVES THAN SMOOTH 


IF (BREAK.EQ.LEFT .OR. BREAK.EQ.RICHT) NINTRP = NINTRP + SMOOTH ~ 


* DBREAK (IBREAR) 


IF (BREAK.EQ.BOTH) NINTRP = NINTRP + 2*SMOOTH ~ DBREAK(IBREAK) - 


* DBREAK(IBREAK+1) 
IF (NINTRP.EQ.@) GO TO 2¢ 
GENERATE EQUAL SPACED INTERPOLATION POINTS 
DX = (XRIGHT (NSTACK)-XLEFT (NSTACK) ) /FLOAT (NINTRP+1) 
DO 1¢ J=1,NINTRP 
XINTRP(J) = XLEFT(NSTACK) + FLOAT(J)*DX 


CONTINUE 


GET LEFT AND RIGHT F-VALUES, PUT F-VALUE IN FIRST ELEMENT 
OF ARRAYS FLEFT AND FRIGHT. 


GET DERIVATIVES BACK AS 


OTHER ELEMENTS VIA THE SUBARRAYS FDERVL AND FDERVR. 


LEFTX = SMOOTH + 1 
RIGHTX = LEFIX 

GET F-VALUES AT OTHER INTERPOLATION POINTS, IF ANY 
IF (NINTRP.EQ.@) GO TO 4¢ 
DO 3@ J=1,NINTRP 


FINTRP(J) = F(XINTRP (J) ,FDUMB) 


CONTINUE 


CHECK FOR BREAK POINTS, MODIFY VALUES IF NECESSARY 


CONTINUE 


IF (BREAK.NE.LEFT) GO TO 5¢ 
LEFTX = DBREAK(IBREAK) + 1 
FLEFT(LEFTX) = BRIGHT (IBREAK) 
IF (BREAK.NE.RIGHT) GO TO 6¢ 
RIGHTX = DBREAK(IBREAK) + 1 
FRIGHT (RIGHTX) = BLEFT(IBREAK) 
IF (BREAK.NE.BOTH) GO TO 7@ 
LEFTX = DBREAK(IBREAK) + 1 
RIGHTX = DBREAK(IBREAK+1) + 1 
FLEFT(LEFTX) = BRIGHT (IBREAK) 


FRIGHT (RIGHTX) = BLEFT(IBREAK+1) 


CONTINUE 


COMPUTE DIVIDED DIFFERENCES, NEWTON FORM OF POLYNOMIAL 


CALL NEWION(LEFTX, RIGHTX, NINTRP) 


COMPUTE NORM OF ERROR OF THIS APPROMIMATION USING FOUR PTS 
ADD 5@ PERCENT FUDGE FACTOR 
ERRORI = ERRINT(F,POLYDD,XLEFT (NSTACK) ,XRIGHT (NSTACK) , ABSC , WGTS) 


ERRORI = 1.5*ERRORI 


RETURN 
END 


REAL FUNCTION ERRINT(F, FIT, AAA, BBB, POINTS, WEIGET) 


A SSR SS SSeS SSSA SRE LSS CREE RR 


THIS FUNCTION DOES A FOUR POINT INTEGRATION RULE FOR THE 


ABSOLUTE VALUE OF THE DIFFERENCE OF TWO FUNCTIONS( F AND FIT ) 


ABS( F(X) - FIT(X) )**NORM 
THE INTEGRATION USES THE POINTS AND WEIGHTS GIVEN AND SCALED 


ERR 
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aa 


* 
* 


FROM (-1,1) TO (AAA,BBB) 


SUBROUTINE NEWTON(NL, NR, NI) 


THIS PROGRAM COMPUTES THE DIVIDED DIFFERENCES ARRAY AS FOLLOWS 


NL COALESCED POINTS ON LEFT - DERIV VALUES IN FLEFT 
NR COALESCED POINTS ON RIGHT - - - - FRIGHT 
NI DISTINCT POINTS INBETWEEN - FNCTN - - FINTRP 
THE POINTS ARE ORDERED XL = XLEFT (NSTACK) 
XR = XRIGHT (NSTACK) 
XINTRP ARRAY 


LAYOUT OF THE DDTEMP DIVIDED DIFFERENCE ARRAY 


NL=6 LLLLLLA*&AT TI 


NR=4 LLLLL*¥*4** 77 L = FIRST TRIANGLE 

NI=2 LLLLAR*ATT 
LLL&®&x* TT R = SECOND TRIANGLE 
LL*¥*AATI 
L&XRKTT * = FILL BETWEEN TRIANGLES 
RRRRIIL 
RRRII I = COMPLETION FOR INTERPOLATION POINTS 
RRII 
RII IDIF = HORIZONTAL COORD. = DIFFERENCE ORDER 
II IPT = VERTICAL COORD. ASSOCIATED WITH POINTS 
I 


REAL A, ACCUR, B, BLEFT, BRIGHT, CHARF, DDTEMP, DSCTOL, ERROR, 
* ERRORI, FACTOR, FINTRP, FLEFT, FRIGHT, NORM, XBREAK, XDD, 

* XINTRP, XLEFT, XRIGHT 

DIMENSION XBREAK(2@), DBREAK(2@), BLEFT(20), BRIGHT (20) 
DIMENSION XLEFT(5@), XRIGHT(5@), FACTOR(12), FMESGE(6) 
DIMENSION DDTEMP(12,12), FINTRP(1@), FLEFT(6), FRIGHT(6), 

* XDD(12), XINTRP(1@) 

INTEGER BOTH, BREAK, DBREAK, DEGREE, EDIST, FMESGE, RIGHT, 
* RIGHTX, SMOOTH 

LOGICAL DISCRD, FATAL, FINISH 

REAL DIFFF, DIFFX 

COMMON /INFUTZ/ A, B, ACCUR, NORM, CHARF, XBREAK, BLEFT, BRIGHT 
* DBREAK, DEGREE, SMOOTH, LEVEL, EDIST, NBREAK, KNTDIM, NPARDM 
COMMON /RESULZ/ ERROR, KNOTS 

COMMON /KONTRL/ DSCTOL, ERRORI, XLEFT, XRIGHT, BREAK, BOTH, 

* FACTOR, FMESGE, IBREAK, INTERP, LEFT, MAXAUX, MAXKNT, MAXPAR, 
* MAXSTK, NPAR, NSTACK, RIGHT, DISCRD, FATAL, FINISH 

COMMON /COMDIF/ DDTEMP, FINTRP, FLEFT, FRIGHT, XDD, XINTIRP, 
* LEFTX, NINTRP, RIGHTX 


MAIN CALCULATION OF DIVIDED DIFFERENCES 
DEFINE A FEW SHORT CONSTANTS 


NLI = NL - 1 
NL2 = NL + 1 
NR1 = NR - 1 
NR2 = NR + 1 
NRL = NR + NL 


PUT X-VALUES IN A SINGLE ARRAY WITH NDDX = NL+NR+NI POINTS 
DO 1@ NDDX=1,NL 
XDD(NDDX) = XLEFT(NSTACK) 


1@ CONTINUE 


NDDX = NL 
DO 2¢ K=1,NR 
NDDX = NDDX + 1 
XDD (NDDX) = XRIGHT(NSTACK) 


29 CONTINUE 
CHECK IF THERE ARE ANY INTERPOLATION POINTS TO ADD TO XDD NEW 


IF (NI.EQ.@) GO TO 4¢ 
DO 3¢ K=1,NI 
NDDKX = NDDX + 1 
XDD(NDDX) = XINTRP(K) 


3¢ CONTINUE 


, NEW 
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Cc NEW 73¢@ 
C FILL BORDER OF FIRST TRIANGLE - SIZE NL. NEW 74¢ 
40 CONTINUE NEW 75¢ 

Cc TOP BORDER NEW 76¢ 
DO 5@ IDIF=1,NL NEW 77¢ 
DDTEMP (IDIF,1) = FLEFT(IDIF) /FACTOR(IDIF) NEW 78 

5@ CONTINUE NEW 790 

IF (NL1.EQ.@) GO TO 7¢ NEW 89¢@ 

Cc BOTTOM BORDER NEW 81¢ 
DO 6@ IDIF=1,NL1 NEW 82¢ 

IPT = NL2 - IDIF NEW 83¢ 
DDTEMP(IDIF,1PT) = DDTEMP(IDIF,1) NEW 84¢ 

60 CONTINUE NEW 85¢@ 

C NEW 860 
C FILL EORDER OF SECOND TRIANGLE - SIZE NR NEW 87¢ 
7@ CONTINUE NEW 88¢@ 

Cc TOP BORDER NEW 890 
DO 8¢ IDIF=1,NR NEW 900 
DDTEMP (IDIF,NL2) = FRIGHT (IDIF) /FACTOR(IDIF) NEW 91¢ 

80 CONTINUE NEW 92¢ 

IF (NRL.EQ.NL2) GO TO 16¢ NEW 93¢ 

Cc BOTTOM BORDER NEW 94¢ 
DO 96 IDIF=1,NR1 NEW 95¢ 

IPT = NRL + 1 - IDIF NEW 96¢ 

DDTEMP (IDIF,IPT) = DDTEMP(IDIF,NL2) NEW 97¢ 

99 CONTINUE NEW 980 

Cc NEW 990 
Cc FILL FARALLOGRAM BETWEEN THE TWO TRIANGLES JUST FILLED NEW 146¢@ 
Cc FILL ENTRIES PARALLEL TO BOTTOM OF FIRST TRIANGLE NEW 1010 
1¢@ CONTINUE NEW 162¢ 

Cc NEW 163¢ 
Cc LOOP STEPPING ALONG TOP SIDE OF SECOND TRIANGLE NEW 164 
DO 12¢ J=2,NR2 NEW 1650 

IDIF = J NEW 1¢6¢ 

Cc LOOP STEPPING PARALLEL TO BOTTOM SIDE OF FIRST TRIANGLE NEW 1¢47¢ 
DO 11@ K=2,NL2 NEW 168@ 

IPT = NL+2-K NEW 169¢ 

DIFFF = DDTEMP(IDIF-1,IPT+1) - DDTEMP (IDIF-1,IPT) NEW 1106¢ 

IPT2 = IPT - 1 + IDIF NEW 1110 

DIFFX = XDD(IPT2) - XDD(IPT) NEW 112¢ 
DDTEMP(IDIF,IPT) = DIFFF/DIFFX NEW 113¢ 

IDIF = IDIF + 1 NEW 114¢ 

11¢ CONTINUE NEW 115¢ 
12¢ CONTINUE NEW 116¢ 

Cc DEBUG DEBUG DEBUG DEBUG NEW 117¢ 
IF (LEVEL.GE.4 .AND. KNOTS.LE.1) WRITE (6,99999) NR2, NL2, IDIF, NEW 118¢ 

* IPT, DIFFF, DIFFX NEW 119¢ 

C NEW 1206¢ 
C FILL IN BOTTOM DIAGONALS FOR INTERPOLATION POINTS, IF ANY NEW 121 
IF (NI.EQ.6) GO TO 15¢ NEW 1220 

Cc LOOP THROUGH THE INTERPOLATATION POINTS NEW 123@ 
DO 14@ J=1,NI NEW 124 

IDIF = 2 NEW 125¢@ 

NRLJ = NRL + J NEW 126@ 
DDTEMP(1,NRLJ) = FINTRP (J) NEW 127¢ 

Cc LOOP THROUGH THE DIFFERENCES (IDIF INDEX) NEW 128¢ 
NRLJ1 = NRLJ - 1 NEW 1290 

DO 13@ K=1,NRLJ1 NEW 13¢6¢ 

IPT = NRLJ - K NEW 131¢ 

DIFFF = DDTEMP(IDIF-1,IPT+1) - DDTEMP (IDIF-1,IPT) NEW 132¢ 

DIFFX = XDD(NRLJ) - XDD(IPT) NEW 133¢ 

DDTEMP (IDIF,IPT) = DIFFF/DIFFX NEW 134¢ 

IDIF = IDIF + l NEW 135@ 

130 CONTINUE NEW 136¢ 
14@ CONTINUE NEW 137¢ 
15¢ CONTINUE NEW 1389 
RETURN NEW 1396 

99999 FORMAT (9X, 3@HNR2,NL2,IDIF,IPT,DIFFF,DIFFX =, 413, 2F12.6) NEW 140¢ 
END NEW 1410 

REAL FUNCTION POLYDu (xX) POL 1¢ 

Cc POL 20 
Cc SRR SS SSS ess PP Tec er oS RSS SSS EHS SSS Heese eS SESS HSS esesesse =P], 36 
C POL 4@ 
C ** THIS FUNCTION EVALUATES THE CURRENT POLYNOMIAL PIECE REPRESENTED POL 5¢ 
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BY THE DIVIDED DIFFERENCES DDTEMP ON THE POINT SET XDD. POL 
POL 

REAL FUNCTION PPOLY(T, XKNOTS, COEFS, KDIMEN, NDIMEN) PPO 
PPO 

EE SSESSS SS Seo eo Sess SSE ee EERSTE SEES EEE Coe Sess PP) 
PPO 

THIS FUNCTION EVALUATES THE PIECEWISE POLYNOMIAL APPROXIMATION PPO 
COMPUTED IN ADAPT PPO 
PPO 

SUBROUTINE PTRANS(D, POWERS) PTR 
PTR 

cecessSceee see eS SERS aE ee SSK CSE eC CE cee eeecx PTR 
PTR 

THIS PROGRAM CONVERTS POLYNOMIAL REPRESENTATION FROM DIVIDED PTR 
DIFFERENCE TO POWER FORM. ‘THERE ARE COALESCED POINTS ON EACH PIR 
END OF THE INTERVAL (XL,XR) = (XLEFT(NSTACK) ,XRIGHT(NSTACK)). PTR 
THE NUMBER COALESCED AT EACH END IS LEFTX AND RIGHTX. PTR 
AND THERE ARE NINTRP OTHER PTS XINTRP(K) INBETWEEN THEM. PTR 
SEE SUBROUTINE NEWTON FOR MORE DETAILS PTR 
PTR 

STARTING REPRESENTATION IS (ASSUMING XL = @ ) PTR 

PTR 

D(1) +D(2)X +D(3)X**2 + -=- +D(NL)X** (NL-1) PTR 
+(X**NL)*( DCNL+1) (4D (NL+2) (X-XR)**2 + --- +D(NL+NR)* (X-XR)**(NR-1) PTR 
* ((X-XR)**NR) * (D (NL+NR+1) + D(NL+NR+2)* (X-XINTIRP (1)) PTR 

+D (NL+NR+3)* (X-XINTRP (1) ) (X-XINIRP(2)) + ---)) PTR 

PTR 


STRATEGY IS ‘TO FIRST CONVERT THE PART FROM THE INTERP. PTS. PTR 
TO POLY IN (X-XR). THIS POLY THEN HAS ORIGIN SHIFTED TO XL. PIR 


PTR 

THE CONVERSION OF THE INTERP PART IS DONE EXPLICITLY FOR DEGREE PTR 
TWO OR LESS AND DONE BY SYNTHETIC DIVISION FOR HIGHER DEGREES PTR 
PTR 

D1 + D2(X-X1) +D3(X**2-(X14+X2)X +X1*X2) PTR 
PTR 

TEE RESULTING COEFFICIENTS ARE PUT IN THE ARRAY ?OWERS PTR 
PTR 

SUBROUTINE PUT(INTERV, XKNOTS, COEFS, KDIMEN, NDIMEN) PUT 
PUT 

SSeS KK cee SSCS SESE SLES SSK SESE SESE CaS Secs es = Pl T 
THIS PROGRAM PUTS INTERVALS ON THE STACK OR DISCARDS THEM. PUT 
WHEN AN INTERVAL IS DISCARDED A NEW KNOT IS FOUND. THEN THIS PUT 


PROGRAM UPDATES THE ERROR ESTIMATE, THE XKNOT ARRAY, TRANSFORMS PUT 
THE POLYNOMIAL TO THE POWER FORM AND PUT THE COEFFICIENTS INTO PUT 
THE ARRAY COEFS. IT ALSO CHECKS FOR PASSING BREAK POINTS PUT 


SUBROUTINE SETUP(XKNOTS, COEFS, KDIMEN, NDIMEN) SET 
SET 


SET 
THIS PROGRAM CHECKS THE INPUT DATA AND INITIALIZES THE COMPUTATIONSET 
SET 


SUBROUTINE SUMARY(XKNOTS, COEFS, KDIMEN, NDIMEN) SUM 


SSeS eee Sees Hee SERS EER SESH SHEESH TEsser eset ecaweeeresscers SM 


THIS PROGRAM PRINTS OUT A SUMMARY OF RESULTS OF ADAPT SUM 


SUBROUTINE TAKE (INTERV) TAK 
TAK 

SSeS r SSS SoSH eee See SoH Se Sse SS SSCS SSeS SE Seer Hesse rere=T AK 
TAK 

THIS PROGRAM TAKES AN ACTIVE INTERVAL OFF THE TOP OF THE STACK TAK 
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c IT ALSO DOES MOST OF THE WORK OF LOCATING AND HANDLING TAK 66 
C BREAK POINTS TAK 79 
Cc TAK & 
SUBROUTINE TERMIN(TEST, AND, PRINT, XKNOTS, KDIMEN) TER 1@ 
Cc TER 26 
C SSeS SS Ll SSL SSS E SSCS ESE SEE Eee seas TER 30 
c TER 4@ 
C ** THIS PROGRAM TESTS FOR TERMINATION AND GIVES INTERMEDIATE OUTPUT TER 56 
C TER 66 
BLOCK DATA BLK 1g 
c SET PARAMETERS FOR FUNCTIONS IN F BLK 26 
REAL PAR2, PAR3A, PAR3B, PAR4, PAR4A, P5A, P5B, P6A, P6B, P7, BLK 30 
* P8A, P&B, P8C, P8D, P8E, P8F, P8G, P8H, P9, PI@A, PI@B, P1QC BLK 40 


COMMON /FPARS/ PAR2, PAR3A, PAR3B, PAR4, PAR4A, P5A, PSB, PéA, BLK 50 
* P6B, P7, P8A, P8B, P8C, P8D, P8E, P8F, P8CG, P8H, P9, PI@A, PI1@B, BLK 6¢ 


* P1@C BLK 7@ 
DATA PAR2, PAR3A, PAR3B, PAR4, PAR4A, P5A, P5B BLK 8@ 
* /.02,.4, .6, .001,6., 8606. , 2637./ BLK 9@ 
DATA P6A, P6B, P7, P8A, P&B, P8C, P8D, P8E /4000.,3998.,.0001,-2.,BLK 160 
* 1.5,7.,5.,9.6/ BLK 11¢ 
DATA P8F, P8G, P8H, P9, PIGA, PIGB, P1@C /.6,14.,16.,1.0,.25,.5, BLK 120 
* .6667/ BLK 13¢ 
END BLK 146 
Cc MAN. 1 
C %**kk THIS PROGRAM RUNS ADAPT WITH DATA READ IN FROM CARDS MAN 2 
Cc IT IS DESIGNED TO TEST ADAPT WITH THE 2¢ FUNCTIONS IN F(X). MAN 3¢ 
C IT READS DATA FOR EVERYTHING EXCEPT EDIST(=ATYPE) AND PRINTS MAN 4@ 
Cc A HEADING WITH THE FUNCTIONS NAME. IT CALLS AND TIMES ADAPT, MAN 50 
Cc THEN INDEPENDENTLY CHECKS THE ERROR IN ADAPT AND PLOTS THE MAN 60 
Cc FUNCTION AND ERROR CURVE. MAN 7 
Cc MAN 8@ 
C NOTES -- USER MUST SUPPLY SYSTEM ROUTINES SECOND AND GRAPH MAN 9¢ 
C INTEGRATION USES ERRINT FROM ADAPT. MAN 160 
Cc PRESENT DIMENSIONS (ON ZKNOTS + ZCOEFS) PREVENT USING MAN 11¢ 
C ERRINIT TO CHECK ACCURACY FOR MORE THAN 16@ KNOTS OR MAN 12¢ 
Cc POLYNOMIAL DEGREE 6. | MAN 13¢ 
Cc QPOLY USED BY ERRINT IS A SINGLE ARGUMENT VERSION OF PPOLY. MAN 14@ 
C SEE COMMENTS IN ADAPT ABOUT DIMENSION CONSTRAINTS AND MAN 15¢ 
C PORTABILITY. MAN 16¢ 
Cc IF ADAPT AND THIS DRIVER ARE CHANGED TO DOUBLE PRECISION MAN 17¢ 
Cc ONE PROBABLY WANTS TO LEAVE TIME,TSTART,TSTOP ,XVALU, MAN 18¢ 
Cc GRAF1,GRAF2 AS SINGLE PRECISION MAN 19¢ 
C THEY ARE SEPARATELY DECLARED HERE. MAN 2¢¢ 
C MAN 210 
REAL FUNCTION F(X, FDERV) F 1¢ 
C F 20 
C ** AN ARRAY OF TWENTY TEST FUNCTIONS WITH 2 TO 5 DERIVATIVES. F 3¢ 
Cc THE DERIVATIVE VALUES ARE PLACED IN FDERV - DIMENSIONED AT 5 F 4@ 
Cc THE FUNCTIONS OF THE SECOND GROUP ARE PARAMETERIZED IN VARIOUS F 5¢ 
Cc WAYS. THE PARAMETERS ARE SET IN BLOCK DATA AND AVAILABLE F 60 
Cc THROUGH THE COMMON BLOCK / FPARS / F 70 
C REQUIRED INPUT INFORMATION IN COMMON BLOCK / FDATA / F 80 
Cc JFUNK = INDEX OF THE FUNCTION SELECTED F 90 
Cc KOUNT = NUMBER OF F-EVALUATIONS F 10@ 
C MAXK = MAXIMUN ALLOWED VALUE OF KOUNT F 11¢ 
Cc REQUIRED CONTROL INFORMATION IN COMMON BLOCK / KONTROL / F 12¢ 
Cc FINISH = SWITCH THAT STOPS ADAPT F rag 
Cc F 1 
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ALGORITHM 526 

Bivariate Interpolation and Smooth Surface 
Fitting for Irregularly Distributed 

Data Points [E1 | 


HIROSHI AKIMA 
Institute for Telecommunication Sciences 


Key Words and Phrases: bivariate interpolation, interpolation, partial derivative, polynomial, smooth 
surface fitting 

CR Categories: 5.13 

Language: ANSI Standard Fortran 


DESCRIPTION 


This algorithm describes the IDBVIP/IDSFFT subprogram package that imple- 
ments the method of bivariate interpolation and smooth surface fitting for irregu- 
larly distributed data points [1]. The package is written in ANSI Standard Fortran 
[2}. 

The package consists of nine subprograms, i.e. eight subroutines and a function. 
Two subroutines, IDBVIP and IDSFFT, are the master subroutines of the pack- 
age, and each interfaces with the user. The IDBVIP subroutine performs bivariate 
interpolation; it estimates the z values at the specified points in the x-y plane. The 
IDSFFT subroutine performs smooth surface fitting; it estimates the z values at 
the specified rectangular grid points in the x-y plane and generates a doubly- 
dimensioned array containing these estimated values. 

The remaining six subroutines are supporting subroutines called by either 
IDBVIP or IDSFFT or by both: IDCLDP determines several data points closest 
to each of the data points; IDGRID organizes output grid points for IDSFFT by 
sorting them in ascending order of triangle numbers; IDLCTN locates a point 
(i.e. determines a triangle in which the point lies) for IDBVIP; IDPDRV estimates 
partial derivatives at the data points; IDPTIP performs punctual interpolation 
(i.e. interpolation at a point); and IDTANG triangulates (or divides into a number 
of triangles) the 2-y plane. A function, IDXCHG, is called by IDTANG and de- 
termines whether or not an exchange of triangles is necessary. 

The package includes two common blocks, IDLC and IDPI. Including these 
common areas, the package occupies approximately 3500 locations on the CDC- 
6600 computer. 

When the user wishes to call either the IDBVIP or the IDSFFT subroutine 
repeatedly with identical data as parts of input data in two consecutive calls, he 
can save computation times considerably by specifying an appropriate mode of 
computation. (This mode is specified with the MD parameter in the call state- 
ments.) 

Tables I and II show the approximate computation times required for the 
IDBVIP and IDSFFT subroutines, respectively, on the CDC-6600 computer when 
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four additional data points are used for estimating partial derivatives at each data 
point (i.e. NCP = 4). In these tables, NDP is the number of data points, NIP is 
the number of output points at which interpolation is to be performed, and NXI 
and NYI are the numbers of output grid points in the x and y coordinates. MD is 
the mode of computation; MD = 1 for a new NCP value and/or a new set of x-y 
coordinates of data points, MD = 2 for an old NCP value, an old set of x-y co- 
ordinates of data points, and a new set of xz-y coordinates of output points, and 
MD = 38 for an old NCP value, an old set of x-y coordinates of data points, and 


TABLE I. Approximate Computation Times Required for the 
IDBVIP Subroutine on the CDC-6600 Computer 


Time (seconds) 


TABLE II. Approximate Computation Times Required for the 


101* 101 


33 * 33 
101* 101 


ll*11 
33 * 33 
101* 101 


1000 


an old set of x-y coordinates of output points. 
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C 
C 
C 
C 
C 
C 
C 
C 


C 


PROGRAM TTIDBS(OUTPUT, TAPE6=OUTPUT) 

THIS PROGRAM IS A TEST PROGRAM FOR THE IDBVIP/IDSFFT SUBPRO- 

GRAM PACKAGE, ALL ELEMENTS OF RESULTING DZI1 AND DZI2 ARRAYS 

ARE EXPECTED TO BE ZERO. 

THE LUN CONSTANT IN THE LAST DATA INITIALIZATION STATEMENT IS 

THE LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS, 

THEREFORE, SYSTEM DEPENDENT. 

DECLARATION STATEMENTS 

DIMENSION XD(3@),YD(3@),ZD(30), 

1 XI(6),Y1I(5),Z1(6,5), 

2 Z11(6,5),Z12(6,5) ,DZ11(6,5) ,DZ12(6,5), 
3 IWK (1030) , WK(24@) 

DATA NCP/4/ 

DATA NDP/3¢/ 

DATA XD(1), XD(2), XD(3), XD(4), XD(5), XD(6), 
XD(7), XD(8), XD(9), XD(1@) ,XD(11) ,xD(12), 
XD(13) ,XD(14) ,XD(15),XD(16) ,XD(17),XD(18), 
XD (19) ,XD(2@) ,XD(21) ,XD(22) ,XD(23) ,XD(24), 
XD (25) ,XD'(26) ,XD(27) ,XD(28) ,XD(29) ,XD (36) / 
11.16, 24.20, 19.85, 10.35, 19.72, 4.40, 
20.87, 19.99, 16.28, 4.51, 6.006, 16.70, 

6.08, 25.60, 14.96, 0.00, 9.66, 5.22, 
11.77, 15.10, 25.00, 25.04, 14.59, 15.2¢, 
5.23, 2.14, @.51, 25.06, 21.67, 3.31/ 

DATA YD(1), YD(2), YD(3), YD(4), YD(5), YD(6), 
YD(7), YD(8), YD(9), YD(16),YD(11),YD(12), 
YD(13) ,YD(14) ,YD(15) ,YD(16) ,YD(17) , YD(18), 
YD(19) ,YD(2@) ,YD(21) ,YD(22) ,YD(23) ,YD(24), 
YD (25) ,YD(26) ,YD(27) ,YD(28) , YD(29) ,YD (30) / 

1.24, 16.23, 14.72, 4.11, 1.39, 206.00, 
20.00, 4.62, 15.16, 20.04, 4.48, 19.65, 
4.58, 11.87, 3.12, 6.060, 20.006, 14.66, 
10.47, 17.19, 3.87, @.06, 8.71, 6.00, 
19.72, 15.03, 8.37, 26.04, 14.36, @.13/ 

DATA ZD(1), ZD(2), ZD(3), ZD(4), ZD(5), ZD(6), 
ZD(7), ZD(8), ZD(9), ZD(16),ZD(11),2D(12), 
ZD(13),ZD(14) ,ZD(15) ,ZD(16) ,ZD(17) ,ZD(18), 
ZD(19) ,ZD(20) ,2D(21) ,ZD(22) ,ZD(23) ,ZD(24), 
ZD(25) ,ZD(26) ,ZD(27) ,ZD(28) ,ZD(29) ,ZD (30) / 
22.15, 2.83, 7.97, 22.33, 16.83, 34.6¢, 

5.74, 14.72, 21.59, 15.61, 61.77, 6.31, 
35.74, 4.46, 21.76, 58.20, 4.73, 40.36, 
13.62, 12.57, 8.74, 12.06, 14.81, 21.60, 
26.50, 53.10, 49.43, 6.60, 5.52, 44.08/ 
DATA NXI/6/, NY¥I/5/ 
DATA XI(1), XI(2), XZ(3), XI(4), XI(5), XI(6)/ 
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1 0.06, 5.06, 16.00, 15.006, 20.06, 25.¢0/ 
DATA YI(1), YI(2), YI(3), YI(4), YI(5)/ 
1 0.90, 5.00, 16.00, 15.60, 26.60/ 


DATA ZI(1,1),Z1(2,1),Z1(3,1),Z1(4,1) ,21(5,1) ,Z1(6,1), 
Z1(1,2),Z1(2,2),2Z1(3,2),21(4,2) ,Z1 (5,2) ,Z1 (6,2), 
Z1(1,3),Z1 (2,3) ,Z1(3,3),21(4,3) ,Z1(5,3) ,Z1 (6,3), 
Z1(1,4) ,21(2,4),Z1(3,4) ,21(4,4) ,Z1(5,4) ,21 (6,4), 
Z1(1,5),21(2,5),Z1(3,5) ,Z1 (4,5) ,Z1(5,5) ,21(6,5)/ 
58.26, 39.55, 26.96, 21.71, 17.68, 12.6¢, 

61.58, 39.39, 22.04, 21.29, 14.36, 8.04, 
59.18, 27.39, 16.78, 13.25, 8.59, 5.36, 
52.82, 40.27, 22.76, 16.61, 7.44, 2.88, 
34.60, 14.05, 4.12, 3.17, 6.31, @.66/ 
DATA LUN/6/ 
CALCULATION 
1¢ MD=1 
DO 12 IYI=1,NYI 
DO 11 IXI=1,NXI 
IF(IXI.NE.1.OR.IYI.NE.1) MD=2 
CALL IDBVIP(MD,NCP ,NDP,XD,YD,ZD,1,XI(IXI) ,YI(IY1), 
1 ZI1(IX1L, IYI) , IWK, WK) 
11 CONTINUE 
12 CONTINUE 
15 CALL IDSFFT(1,NCP,NDP,XD,YD,ZD,NXI,NYI,XI,YI,Z12, IWK, WK) 
DO 17. IYI=1,NYI 
DO 16 IXI=1,NXI 
DZI1(IXI, 1YI)=ABS(ZI1(IXL, IYI) -ZI (1X1, IYI)) 
DZ12 (1X1, IYI)=ABS (Z12(IXI, IYI)-ZI(IX1, IYI) ) 
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16 CONTINUE 
17 CONTINUE 
C PRINTING OF INPUT DATA 
2@ WRITE (LUN, 2020) NDP 
DO 23 IDP=1,NDP 
IF (MOD (IDP,5).EQ.1) 
WRITE (LUN, 2622) 
23 CONTINUE 
C PRINTING OF OUTPUT RESULTS 
3@ WRITE (LUN, 2630) 
WRITE (LUN,2@31) YI 
DO 33. IXI=1,NXI 
WRITE (LUN, 2032) 
33 CONTINUE 
4Q@ WRITE (LUN, 2064) 
WRITE (LUN,2@31) YI 
DO 43 IXI=1,NXI 
WRITE (LUN, 2032) 
43 CONTINUE 
5@ WRITE (LUN, 2050) 
WRITE (LUN, 2031) YI 
DO 53. IXI=1,NXI 
WRITE (LUN, 2032) 
53 CONTINUE 
6@ WRITE (LUN, 2060) 
WRITE (LUN,2631) YI 
DO 63 IXI=1,NXI 
WRITE (LUN, 2632) 
63 CONTINUE 
STOP 
C FORMAT STATEMENTS 
2020 FORMAT(1H1,6HTTIDBS/////3X,1@HINPUT DATA, 8X,5HNDP =,13/// 
1 30H I XD YD zD /) 
2021 FORMAT(1X) 
2022 FORMAT (5X,12, 2X, 3F7.2) 
2030 FORMAT(1H1,6HTTIDBS/////3X,17HIDBVIP SUBROUTINE/// 
1 26X,1@HZ11(X1I,YI)) 
2031 FORMAT (7X, 2HX1,4X, 3HYI=/12X,5F7.2/) 
2032 FORMAT (1X/1X,F9.2,2X,5F7.2) 
264@ FORMAT (1X/////3X, 1OHDIFFERENCE/// 
1  25X,11HDZI1(X1,YI)) 
205@ FORMAT (1H1,6HTTIDBS/////3X,17HIDSFFT SUBROUTINE/// 
1 26X,1@HZI2(XI,YI)) 
2060 FORMAT (1X/////3X, 1OHDIFFERENCE/ // 
1  25X,11HDZ12(XI,YI)) 
END 


WRITE (LUN, 2021) 
IDP,XD(IDP) ,YD(IDP) ,ZD(IDP) 


XI(IXI), (ZI1(IXI, IYI) , IYI=1,NYI) 
XI (IXI) , (DZI1(IXI, IYI) , IYI=1,NYI) 
XI (IXI) , (ZI2(IX1I, IYL) ,IYI=1,NYI) 


XI(IXI) , (DZI2(IXI, IYI) , IYI=1,NYI) 


SUBROUTINE IDBVIP(MD,NCP,NDP,XD,YD,ZD,NIP,XI,YI,ZI, 
1 IWK, WK) 
C THIS SUBROUTINE PERFORMS BIVARIATE INTERPOLATION WHEN THE PRO- 
C JECTIONS OF THE DATA POINTS IN THE X-Y PLANE ARE IRREGULARLY 
C DISTRIBUTED IN THE PLANE. 
C THE INPUT PARAMETERS ARE 
MD = MODE OF COMPUTATION (MUST BE 1, 2, OR 3), 
= 1 FOR NEW NCP AND/OR NEW XD-YD, 
= 2 FOR OLD NCP, OLD XD-YD, NEW XI-YI, 
= 3 FOR OLD NCP, OLD XD-YD, OLD XI-YI, 
NCP = NUMBER OF ADDITIONAL DATA POINTS USED FOR ESTI- 
MATING PARTIAL DERIVATIVES AT EACH DATA POINT 
(MUST BE 2 OR GREATER, BUT SMALLER THAN NDP), 
NDP = NUMBER OF DATA POINTS (MUST BE 4 OR GREATER), 


XD ARRAY OF DIMENSION NDP CONTAINING THE X 
COORDINATES OF THE DATA POINTS, 
YD = ARRAY OF DIMENSION NDP CONTAINING THE Y 


COORDINATES OF THE DATA POINTS, 

ZD = ARRAY OF DIMENSION NDP CONTAINING THE Z 
COORDINATES OF THE DATA POINTS, 

NIP = NUMBER OF OUTPUT POINTS AT WHICH INTERPOLATION 
IS TO BE PERFORMED (MUST BE 1 OR GREATER), 

XI = ARRAY OF DIMENSION NIP CONTAINING THE X 
COORDINATES OF THE OUTPUT POINTS, 

YI = ARRAY OF DIMENSION NIP CONTAINING THE Y 
COORDINATES OF THE OUTPUT POINTS. 


C 
C 
C 
C 
C 
C 
C 
C 
C 
Cc 
C 
C 
C 
Cc 
C 
C 
C 
Cc 
C 
C 
C THE OUTPUT PARAMETER IS 
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ZI = ARRAY OF DIMENSION NIP WHERE INTERPOLATED Z 
VALUES ARE TO BE STORED. 
THE OTHER PARAMETERS ARE 
IWK = INTEGER ARRAY OF DIMENSION 
MAX@ (31, 27+NCP) *NDP+NIP 
USED INTERNALLY AS A WORK AREA, 
WK = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A 
WORK AREA. 
THE VERY FIRST CALL TO THIS SUBROUTINE AND THE CALL WITH A NEW 
NCP VALUE, A NEW NDP VALUE, AND/OR NEW CONTENTS OF THE XD AND 
YD ARRAYS MUST BE MADE WITH MD=l1. THE CALL WITH MD=2 MUST BE 
PRECEDED BY ANOTHER CALL WITH THE SAME NCP AND NDP VALUES AND 
WITH THE SAME CONTENTS OF THE XD AND YD ARRAYS. THE CALL WITH 
MD=3 MUST BE PRECEDED BY ANOTHER CALL WITH THE SAME NCP, NDP, 
AND NIP VALUES AND WITH THE SAME CONTENTS OF THE XD, YD, XI, 
AND YI ARRAYS. BETWEEN THE CALL WITH MD=2 OR MD=3 AND ITS 
PRECEDING CALL, THE IWK AND WK ARRAYS MUST NOT BE DISTURBED. 
USE OF A VALUE BETWEEN 3 AND 5 (INCLUSIVE) FOR NCP IS RECOM- 
MENDED UNLESS THERE ARE EVIDENCES THAT DICTATE OTHERWISE. 
THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE 
LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS, 
THEREFORE, SYSTEM DEPENDENT. 
THIS SUBROUTINE CALLS THE IDCLDP, IDLCTN, IDPDRV, IDPTIP, AND 
IDTANG SUBROUTINES. 
DECLARATION STATEMENTS 
DIMENSION XD(1060) ,YD(100) ,2D(10@) ,X1 (10660) ,YI (1400) , 
I ZI (1606) , WK (4160) ,WK (800) 
COMMON/IDLC/NIT 
COMMON/IDPL/ITPV 
DATA LUN/6/ 
SETTING OF SOME INPUT PARAMETERS TO LOCAL VARIABLES. 
(FOR MD=1, 2,3) 
19 MD@=MD 
NCP@=NCP 
NDP¢=NDP 
NIP@=NIP 
ERROR CHECK. (FOR MD=1,2,3) 
2@ IF(MD@.LT.1.0R.MD@.GT.3) 
IF (NCP@.LT.2.OR.NCP@.GE.NDPQ) 
IF (NDP@.LT.4) 
IF (NIP@.LT.1) 
IF (MD@.GE.2) 
IWK(1)=NCPO 
IWK(2)=NDP@ 
GO TO 22 
21 NCPPV=IWK(1) 
NDPPV=IWK (2) 
IF (NCP@.NE.NCPPV) 
IF (NDP@.NE.NDPPV) 
22 IF (MD@.GE.3) 
IWK(3)=NIP 
GO TO 30 
23 NIPPV=IWK (3) 
IF(NIP®@.NE.NIPPV) GO TO 9¢ 
ALLOCATION OF STORAGE AREAS IN THE IWK ARRAY. 
3¢ JWIPT=16 
JWIWL=6*NDPG+1 
JWIWK=JWIWL 
JWIPL=24*NDPG+1 
JWIWP=3@*NDPG+1 
JWIPC=27*NDPG+1 
JWITO=MAXG (31, 27+NCPO) *NDPO 
TRIANGULATES THE X-Y PLANE. (FOR MD=1) 
40 IF(MD@.GT.1) GO TO 5¢ 
CALL IDTANG(NDP¢,XD,YD,NT, IWK(JWIPT) ,NL,IWK(JWIPL) , 
1 IWK(JWIWL) , WK (JWIWP) , WK) 
IWK(5)=NT 
IWK (6) =NL 
IF (NT.EQ.@) RETURN 
DETERMINES NCP POINTS CLOSEST TO EACH DATA POINT. 
5@ IF(MD@.GT.1) GO TO 6¢ 
CALL IDCLDP(NDP@,XD,YD,NCP@, IWK(JWIPC) ) 
IF (IWK (JWIPC) .EQ.@) RETURN 
LOCATES ALL POINTS AT WHICH INTERPOLATION IS TO BE PERFORMED. 
(FOR MD=1,2) 
60 IF(MDG.EQ.3) 
NIT=@ 


GO TO 9¢ 
GO TO 9¢ 
GO TO 9¢ 


GO TO 9¢ 
GO TO 21 


GO TO 9@ 
GO TO 90 
GO TO 23 


(FOR MD=1,2,3) 


(FOR MD=1) 


GO TO 7¢ 
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JWIT=JWIT@ 
DO 61 IIP=1,NIP¢ 
JWIT=JWIT+1 
CALL IDLCTN(NDP(@,XD,YD,NT, IWK(.TWIPT) ,NL, IWK(JWIPL) , 
1 XI(LIP) ,YICLIP) , IWK(JWIT) , INWK(JWIWK) , WK) 
61 CONTINUE 
C ESTIMATES PARTIAL DERIVATIVES AT ALL DATA POINTS. 
C (FOR MD=1, 2, 3) 
7@ CALL IDPDRV(NDP@,XD,YD,ZD,NCP@, IWK (JWIPC) ,WK) 
C INTERPOLATES THE ZI VALUES. (FOR MD=1,2,3) 
86 ITPV=¢ 
JWIT=JWITO 
DO 81 IIP=1,NIPO 
JWIT=JWLT+1 
CALL IDPTIP(XD,YD,ZD,NT, IWK(JWIPT) ,NL, IWK(JWIPL) , WK, 
1 IWK(JWIT) ,XI(IIP),YI(IIP) ,ZI(1IP)) 
81 CONTINUE 
RETURN 
C ERROR EXIT 
9% WRITE (LUN, 2696) MD@,NCPO,NDPO,NIPO 
RETURN 
C FORMAT STATEMENT FOR ERROR MESSAGE 
209% FORMAT(1X/41H *** IMPROPER INPUT PARAMETER VALUE(S) ./ 
1 7H MD =,14,1@X,5HNCP =,16,1@X,5HNDP =,16, 
2 1@X,5HNIP =,16/ 
3 35H ERROR DETECTED IN ROUTINE 
END 


IDBVIP/) 


SUBROUTINE IDCLDP(NDP,XD,YD,NCP, IPC) 
THIS SUBROUTINE SELECTS SEVERAL DATA POINTS THAT ARE CLOSEST 
TO EACH OF THE DATA POINT. 
THE INPUT PARAMETERS ARE 
NDP = NUMBER OF DATA POINTS, 
XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y 
COORDINATES OF THE DATA POINTS, 
NCP = NUMBER OF DATA POINTS CLOSEST TO EACH DATA 
POINTS. 
THE OUTPUT PARAMETER IS 
IPC = INTEGER ARRAY OF DIMENSION NCP*NDP, WHERE THE 
POINT NUMBERS OF NCP DATA POINTS CLOSEST TO 
EACH OF THE NDP DATA POINTS ARE TO BE STORED. 
THIS SUBROUTINE ARBITRARILY SETS A RESTRICTION THAT NCP MUST 
NOT EXCEED 25. 
THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE 
LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS, 
THEREFORE, SYSTEM DEPENDENT. 
DECLARATION STATEMENTS 
DIMENSION XD(10@),YD(160), IPC (460) 
DIMENSION DSQ@(25),TPCO(25) 
DATA NCPMX/25/, LUN/6/ 
C STATEMENT FUNCTION 
DSQF(UL,V1,U2,V2)=(U2-U1) **2+(V2-V1) **2 
C PRELIMINARY PROCESSING 
10 NDP@=NDP 
NCP@=NCP 
IF(NDP@.LT.2) GO TO 9¢ 
IF (NCP@.LT.1.O0R.NCP@.GT.NCPMX.OR.NCP@.GE.NDP@) 
C CALCULATION 
2@ DO 59 IPl=1,NDP@ 
C - SELECTS NCP POINTS. 
X1=XD (IP1) 
Yl=YD(IP1) 
J1=¢ 
DSQMX=¢ .@ 
DO 22 IP2=1,NDPO 
IF(IP2.EQ.IP1) GO TO 22 
DSQI=DSQF (X1,¥1,XD(IP2) , YD (IP2) ) 
J1=J1+1 
DSQO(J1)=DSQI 
IPC@(J1)=IP2 
IF (DSQL.LE.DSQMX) 
DSQMKX=DSQI 
JMX=J1 
21 IF (J1.GE.NCP@) 
22 CONTINUE 


qaangnannaaganananaannaanaan 


GO TO 9¢ 


GO TO 21 


GO TO 23 
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23 IP 2MN=IP2+1 


IF (IP2MN.GT .NDP@) GO TO 3¢ 
DO 25 IP2=IP2MN,NDP@ 
IF(IP2.EQ.IP1) GO TO 25 


DSQI=DSQF(X1,Y1,XD(IP2) ,YD(IP2)) 
LF (DSQI.GE.DSQMX) GO TO 25 
DSQ@(JMX)=DSQI 
IPC@(JMX)=IP2 
DSQMX=@.@ 
DO 24 Jl=1,NCP¢ 
IF (DSQ@(J1) .LE.DSQMX) 
DSQMX=DSQ0(J1) 
JMX=J 1 
24 CONTINUE 
25 CONTINUE 
C - CHECKS IF ALL THE NCP+l1 POINTS ARE COLLINEAR. 
3@ IP2=IPC¢(1) 
DX12=XD (IP2)-X1 
DY12=YD(IP2)-Y1 
DO 31 J3=2,NCP¢ 
IP3=IPCO(J3) 
DX13=XD (IP3)-X1 
DY13=YD(IP3)-Y1 
IF ((DY13*DX12-DX13*DY12) .NE.0.0) 
31  CONTINUY 
C ~ SEARCHES FOR THE CLOSEST NONCOLLINEAR POINT. 
46  NCLPT=¢ 
DO 43 IP3=1,NDP¢ 
IF (IP3.EQ.IP1) 
DO 41 J4=1,NCPO 
IF (IP3.EQ.IPCO(J4)) 
41 CONTINUE 
DX13=XD (IP3)-X1 
DY13=YD(IP3)~Y1 
IF ((DY13*DX12-DX13*DY12) .EQ.@.@) 
DSQI=DSQF (X1,Y1,XD(IP3) ,YD(IP3)) 
IF (NCLPT.EQ.@) GO TO 42 
IF (DSQI.GE.DSQMN) GO TO 43 
42 NCLPT=1 
DSQMN=DSQI 
IP3MN=1P3 
43. CONTINUE 
IF (NCLPT .EQ.@) 
DSQMX=DSQMN 
IPC@(JMX)=IP3MN 
C = REPLACES THE LOCAL ARRAY FOR THE OUTPUT ARRAY. 
5@ Jl=(IP1-1)*NCPO 
DO 51 J2=1,NCP¢ 
Jl=J1+1 
IPC(J1)=IPC@(J2) 
51 CONTINUE 
59 CONTINUE 
RETURN 
C ERROR EXIT 
9@ WRITE (LUN, 2090) 
GO TO 92 
91 WRITE (LUN, 20691) 
92 WRITE (LUN, 2692) 
IPC(1)=¢@ 
RETURN 
C FORMAT STATEMENTS FOR ERROR MESSAGES 
2090 FORMAT(1X/41H *** IMPROPER INPUT PARAMETER VALUE(S) .) 
2091 FORMAT(1X/33H *** ALL COLLINEAR DATA POINTS.) 
2992 FORMAT(8H NDP =,15,5X,5HNCP =,15/ 
1 35H ERROR DETECTED IN ROUTINE 
END 


GO TO 24 


GO TO 5¢ 


GO TO 43 


GO TO 43 


GO TO 43 


GO TO 91 


NDP@,NCP@ 


IDCLDP/) 


SUBROUTINE IDGRID(XD, YD, NT, IPT, NL, IPL, NXI, NYI, XI, YI, 

* NGP, IGP) 
THIS SUBROUTINE ORGANIZES GRID POINTS FOR SURFACE FITTING BY 
SORTING THEM IN ASCENDING ORDER OF TRIANGLE NUMBERS AND OF THE 
BORDER LINE SEGMENT NUMBER. 
THE INPUT PARAMETERS ARE 

XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y 

COORDINATES OF THE DATA POINTS, WHERE NDP IS THE 
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NUMBER OF THE DATA POINTS, 

NT = NUMBER OF TRIANGLES, 

IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE 

POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES, 

NUMBER OF BORDER LINE SEGMENTS, 

INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE 

POINT NUMBERS OF THE END POINTS OF THE BORDER 

LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE 

NUMBERS, 

NXI = NUMBER OF GRID POINTS IN THE X COORDINATE, 

NYI = NUMBER OF GRID POINTS IN THE Y COORDINATE, 

XI,YI = ARRAYS OF DIMENSION NXI AND NYI CONTAINING 
THE X AND Y COORDINATES OF THE GRID POINTS, 
RESPECTIVELY . 

OUTPUT PARAMETERS ARE 

NGP = INTEGER ARRAY OF DIMENSION 2*(NT+2*NL) WHERE THE 
NUMBER OF GRID POINTS THAT BELONG TO EACH OF THE 
TRIANGLES OR OF THE BORDER LINE SEGMENTS ARE TO 
BE STORED, 

IGP = INTEGER ARRAY OF DIMENSION NXI*NYI WHERE THE 
GRID POINT NUMBERS ARE TO BE STORED IN ASCENDING 
ORDEk OF THE TRIANGLE NUMBER AND THE BORDER LINE 
SEGMENT NUMBER. 


a 


DECLARATION STATEMENTS 
DIMENSION XD(10@), YD(10@), IPT(585), IPL(306), XI(161), 


YI(101), NGP(80¢), IGP(196201) 


C STATEMENT FUNCTIONS 


SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3) - (V1-V3)*(U2-U3) 
SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2) + (V1-V2)*(V3-V2) 


C PRELIMINARY PROCESSING 


16 


20 


36 


NI@ = NT 

NL@ = NL 

NXI@ = NXI 

NYI@ = NYL 

NXINYI = NXI@*NYIO 

XIMN = AMINI(XI(1),XI(NXI@)) 
XIMK = AMAX1(XI(1),XI(NXIQ)) 
YIMN = AMINI(YI(1) ,YI(NYIQ@)) 


“YIMX = AMAX1(YI(1),YI(NYI@)) 
C DETERMINES GRID POINTS INSIDE THE DATA AREA, 


JINGP@ = @ 
JNGP1 = 2*(NT@+2*NL@) + 1 
JIGP¢é = @ 
JIGP1 = NXINYI + l 
DO 16@ ITO=1,NTO 
NGP@ = @ 


ITOT3 = ITO*3 


IPl = IPT(ITOT3-2) 
IP2 = IPT(IT@£3-1) 
IP3 = IPT(ITOT3) 

Xl = XD(IP1) 

Yl = YD(IP1) 

X2 = XD(IP2) 

Y2 = YD(IP2) 

X3 = XD(IP3) 

Y3 = YD(IP3) 

XMN = AMIN1(X1,X2,X3) 
XMX = AMAX1(X1,X2,X3) 
YMN = AMIN1(Y1,Y2,Y3) 
YMX = AMAX1(Y1,Y2,Y3) 
INSD = @ 


DO 2@ IXI=1,NXI@ 
IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 10 
IF (INSD.EQ.6) GO TO 2¢ 
IXIMX = IXI - 1 
GO TO 3¢ 
IF (INSD.EQ.1) GO TO 2¢ 
INSD = 1 
IXIMN = IXI 
CONTINUE 
IF (INSD.EQ.6) GO TO 15¢ 
IXIMX = NXI@ 
DO 14@ IYI=1,NYIO 
YII = YI(IYI) 
IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 14@ 
DO 13¢ IXI=IXIMN, IXIMX 
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19¢ 


11¢ 
12¢ 


13¢ 
14¢ 
156 


XII = XI(IXI) 


L=@ 
IF (SIDE(X1,Y1,X2,Y2,XII,YII)) 13¢, 40, 5¢ 
Le=1l 
IF (SIDE(X2,Y2,X3,Y3,XII,YII)) 1306, 60, 7@ 
: Aa | 
IF (SIDE(X3,Y3,X1,Y1,XII,YII)) 13¢, 8@, 9¢ 
L=1 


IZI = NXI@*(1IYI-1) + IXI 
IF (L.EQ.1) GO TO 106¢ 
NGP@ = NGPG + 1 
JIGP¢ = JIGPO@ + 1 
IGP(JIGP@) = IZ1 
GO TO 13¢ 
IF (JIGP1.GT.NXINYI) GO TO 12@ 
DO 11@ JIGP1I=JIGP1,NXINYI 
IF (IZI.EQ.IGP(JIGP11)) GO TO 13¢ 
CONTINUE 
NGP1 = NGP1 + 1 
JIGP1 = JIGP1 - 1 
IGP(JIGP1) = IZI 
CONTINUE 
CONTINUE 
JNGP@ = JNGP@ + 1 
NGP(JNGP@) = NGP@ 
JNGP1 = JNGP1 - 1 
NGP(JNGP1) = NGP1 


160 CONTINUE 
C DETERMINES GRID POINTS OUTSIDE THE DATA AREA. 
C ~ IN SEMI-INFINITE RECTANGULAR AREA. 


17¢ 


18¢ 


19¢ 


DO 45@ IL@=1,NLO 


NGP@ = @ 
NGP1 = @¢ 
ILOT3 = ILO*3 

IP1 = IPL(ILOT3-2) 
IP2 = IPL(IL@T3-1) 
Xl = XD(IP1) 

Yl = YD(IP1) 

X2 = XD(IP2) 

Y2 = YD(IP2) 

XMN = XIMN 

XMX = XIMX 

YMN = YIMN 

YMX = YIMX 

IF (Y2.GE.Y1) XMN 
IF (Y2.LE.Y1) XMX 
IF (X2.LE.X1) YMN 
IF (X2.GE.X1) YMX 
INSD = @ 

DO 18@ IXI=1,NXI@¢ 


AMIN1 (X1,X2) 
AMAX1 (X1,X2) 
AMIN1 (¥1,Y2) 
AMAX1 (¥1,Y2) 


IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 17¢ 


IF (INSD.EQ.¢) GO TO 18¢ 
IXIMX = IXI - l 
GO TO 199 
IF (INSD.EQ.1) GO TO 18¢ 
INSD = 1 
IXIMN = IXI 
CONTINUE 
IF (INSD.EQ.@) GO TO 31¢ 
IXIMX = NXI@ 
DO 3@@ IYI=1,NYI@ 
YII = YI(IYI) 
IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 3¢¢ 
DO 29 IXI=IXIMN, IXIMX 
XII = XI(IXI) 
L=4¢@ 


IF (SIDE(X1,Y1,X2,Y2,XII,YII)) 216, 20@, 29¢ 


L=1 


L 1 


IF (SPDT(X1,Y1,X2,Y¥2,XII,YII)) 296, 240, 25¢ 


L=1 

IZI = NXI@*(IYI-1) + IXI 
IF (L.EQ.1) GO TO 26¢ 
NGP@ = NGPG@ + 1 

JIGP@ = JIGP¢ + 1 
IGP(JIGP@) = IZ1 


IF (SPDT(X2,Y2,X1,Y1,XII,YII)) 296, 226, 23¢ 
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260 


GO TO 29¢ 
IF (JIGP1.GI.NXINYI) GO TO 28¢ 
DO 274 JIGP1I=JIGP1,NXINYI 
IF (IZI.EQ.IGP(JIGPII)) GO TO 29¢ 
CONTINUE 
NGP1 = NGP1 + 1 
JIGP1 = JIGP1 - 1 
IGP(JIGP1) = IZI 
CONTINUE 
CONTINUE 
JINGP® = INGPG + 1 
NGP(JNGP®) = NGP@ 
JNGP1 = JNGP1 - 1 
NGP(JNGP1) = NGP1 


C ~ IN SEMI-INFINITE TRIANGULAR AREA. 


320 


330 


340 


35¢ 
360 
370 
380 


390 


460 
416 


42¢ 
436 
Lag 


NGPO = @ 

NGP1 = @ 

ILP1 = MOD(IL@,NLO) + 1 

ILP1T3 = ILP1*3 

IP3 = IPL(ILP1T3-1) 

X3 = XP/TP3) 

Y3 = YbD\LP3) 

XMN = “IMN 

XMX = XIMX 

YMN = YIMN 

YMX = YIMX 

IF (Y3.GE.Y2 .AND. Y2.GE.Y1) XMN = x2 
IF (Y3.LE.Y2 ./"D. Y2.LE.Y1) XMK = X2 
IF (X3.LE.X2 .AND. X2.LE.X1) YMN = Y2 
IF (X3.GE.X2 .AND. X2.GE.X1) YMX = Y2 
INSD = @ 

DO 330 IXI=1,NXI@ 


IF (XI(IXI).GE.XMN .AND. XI(IXI).LE.XMX) GO TO 32¢ 


IF (INSD.EQ.%) GO TO 33¢ 
IXIMX = IXI - 1 
GO TO 34¢ 
IF (INSD.EQ.1) GO TO 330 
INSD = 1 
IXIMN = IXI 
CONTINUE 
IF (INSD.EQ.@) GO TO 44¢ 
IXIMX = NXI@ 
DO 43@ IYI=1,NYI¢ 
YII = YI(IYI) 


IF (YII.LT.YMN .OR. YII.GT.YMX) GO TO 43@ 


DO 420 IXI=IXIMN, IXIMX 
XII = XI(IXI) 
L= @ 


IF (SPDT(X1,Y¥1,X2,Y¥2,XII,YII)) 360, 350, 42¢ 


L=l 


IF (SPDT (X3,Y3,X2,Y2,XII,YII)) 386, 376, 420 


L=l 
IZI = NXI@*(IYI-1) + IXI 
IF (L.EQ.1) GO TO 39¢ 
NGP@ = NGP@ + 1 
JIGP@ = JIGP@ + 1 
IGP(JIGP@) = IZI 
GO TO 426 
IF (JIGP1.GT.NXINYI) GO TO 41¢ 
DO 46¢ JIGP1I=JIGP1,NXINYI 
IF (IZI.EQ.IGP(JIGP1I)) GO TO 42¢ 
CONTINUE 
NGP1 = NGP1 + 1 
JIGP1 = JIGP1 - 1 
IGP(JIGP1) = IZI 
CONTINUE 
CONTINUE 
JNGP® = JNGPG + 1 
NGP(JNGP}) = NGPO 
JNGP1 = JNGP1 - 1 
NGP(JNGP1) = NGP1 


45@ CONTINUE 


RETURN 
END 


163¢ 
164¢ 
165¢@ 
1660 
167¢ 
1686 
169¢ 
1700 
171¢ 
172¢ 
173@ 
1740 


; 1750 


1760 
1770 
178¢ 
179¢ 
1869 
1810 
182¢ 
183¢ 
184¢ 
185¢ 
1860 
187@ 
188@ 
189¢ 
1900 
191¢ 
1926 
193¢ 
1949 
195¢ 
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198¢ 
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2000 
201¢ 
2020 
2030 
2040 
20650 
2060 
2070 
208¢ 
2096 
21460 
2110 
2120 
2130 
2146 
2150 
216¢ 
2170 
218¢ 
2190 
2200 
221¢ 
2220 
223¢ 
2240 
2250 
2260 
2270 
2280 
2299 
2360 
2316 
2326 
233¢ 
2340 
2356 
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a 


C 


C 
C 


SUBROUTINE IDLCTN(NDP, XD, YD, NI, IPT, NL, IPL, XII, YII, ITI, 


* IWK, WK) 
THIS SUBROUTINE LOCATES A POINT, I.E., DETERMINES TO WHAT TRI- 
ANGLE A GIVEN POINT (XII,YII) BELONGS. WHEN THE GIVEN POINT 
DOES NOT LIE INSIDE THE DATA AREA, THIS SUBROUTINE DETERMINES 
THE BORDER LINE SEGMENT WHEN THE POINT LIES IN AN OUTSIDE 
RECTANGULAR AREA, AND TWO BORDER LINE SEGMENTS WHEN THE POINT 
LIES IN AN OUTSIDE TRIANGULAR AREA. 
THE INPUT PARAMETERS ARE 
NDP = NUMBER OF DATA POINTS, 
XD,YD = ARRAYS OF DIMENSION NDP CONTAINING THE X AND Y 
COORDINATES OF THE DATA POINTS, 
NI = NUMBER OF TRIANGLES, 
IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE 
POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES, 
NL = NUMBER OF BORDER LINE SEGMENTS, 
IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE 
POINT NUMBERS OF THE END POINTS OF THE BORDER 
LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE 
NUMBERS, 
XII,YII = X AND Y COORDINATES OF THE POINT TO BE 
LOCATED. 
THE OUTPUT PARAMETER IS 
ITI = TRIANGLE NUMBER, WHEN THE POINT IS INSIDE THE 
DATA AREA, OR 
TWO BORDER LINE SEGMENT NUMBERS, IL1 AND IL2, 
CODED TO IL1*(NT+NL)+IL2, WHEN THE POINT IS 
OUTSIDE THE DATA AREA. 
THE OTHER PARAMETERS ARE 
IWK = INTEGER ARRAY OF DIMENSION 18*NDP USED INTER- 
NALLY AS A WORK AREA, — 
WK = ARRAY OF DIMENSION 8*NDP USED INTERNALLY AS A 
WORK AREA. 
DECLARATION STATEMENTS 
DIMENSION XD(16@0), YD(16¢), IPT(585), IPL(3@0), IWK(18@@), 
* WK(86¢) 
DIMENSION NTSC(9), IDSC(9) 
COMMON /IDLC/ NIT 
STATEMENT FUNCTIONS 


SIDE(U1,V1,U2,V2,U3,V3) = (U1-U3)*(V2-V3) - (V1-V3)*(U2-U3) 
SPDT(U1,V1,U2,V2,U3,V3) = (U1-U2)*(U3-U2) + (V1-V2)*(V3-V2) 


PRELIMINARY PROCESSING 
NDP@ = NDP 
NT@ = NT 
NL@ = NL 
NIL = NTO + NLO 
X@ = XII 
Y@ = YII 
PROCESSING FOR A NEW SET OF DATA POINTS 
IF (NIT.NE.@) GO TO 8@ 
NIT = 1 
- DIVIDES THE X-Y PLANE INTO NINE RECTANGULAR SECTIONS. 


DO 1¢@ IDP=2,NDP¢ 
XI = XD(IDP) 
YI = YD(IDP) 
XMN = AMIN1 (XI, XMN) 
XMX = AMAX1 (XI, XMX) 
YMN = AMINI (YI, YMN) 
YMX = AMAX1 (YI, YMX) 
16 CONTINUE 
XS1 = (XMN+XMN+XMX)/3.¢ 
XS2 = (XMN+XMX+XMK)/3.¢ 
YS1 = (YMN+YMN+YMX)/3.@ 
YS2 = (YMN+YMX+YMX) /3.0 
~- DETERMINES AND STORES IN THE IWK ARRAY TRIANGLE NUMBERS OF 
- THE TRIANGLES ASSOCIATED WITH EACH OF THE NINE SECTIONS. 
DO 2¢ ISC=1,9 
NTSC(ISC) = @ 
IDSC(ISC) = @ 
2¢ CONTINUE 
ITOT3 = @ 
JWK = @ 
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3¢ 


40 


5¢ 


60 


C - STORES IN THE WK ARRAY THE MINIMUM AND MAXIMUM OF THE X AND 


DO 7¢ IT@=1,NT¢ 
ITOT3 = ITGT3 + 3 
Il = IPT(ITOT3-2) 
I2 = IPT(ITOT3-1) 
I3 = IPT(IT@T3) 


XMN = AMIN1(XD(I1) ,XD(I2) ,XD(13)) 
XMX = AMAX1(XD(I1) ,XD(I2),XD(I3)) 
YMN = AMINI(YD(I1) ,YD(12) ,YD(I3)) 
YMX = AMAXI(YD(I1) ,YD(12) ,YD(13)) 


IF (YMN.GT.YS1) GO TO 3¢ 
IF (XMN.LE.XS1) IDSC(1) = 1 


IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(2) = 1 


IF (XMX.GE.XS2) IDSC(3) = 1 


IF (YMX.LT.YS1 .OR. YMN.GT.YS2) GO TO 4¢@ 


IF (XMN.LE.XS1) IDSC(4) = 1 


IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(5) = 1 


IF (XMX.GE.XS2) IDSC(6) = 1 
IF (YMX.LT.YS2) GO TO 5¢ 
IF (XMN.LE.XS1) IDSC(7) = 1 


IF (XMX.GE.XS1 .AND. XMN.LE.XS2) IDSC(8) = 1 


IF (XMX.GE.XS2) IDSC(9) = 1 

DO 6¢ Isc=1,9 
IF (IDSC (ISC) .EQ.¢) GO TO 6¢ 
JIWK = 9*NTSC(ISC) + ISC 
IWK(JIWK) = IT@ 
NTSC(ISC) = NTSC(ISC) + 1 
IDSC(ISC) = @ 

CONTINUE 


C - Y COORDTNATE VALUES FOR EACH OF THE TRIANGLE. 


WK(JWK-3) = XMN 
WK(JWK-2) = XMX 
WK(JWK-1) = YMN 
WK(JWK) = YMX 
7@ CONTINUE 
GO TO 11¢ 
C CHECKS IF IN THE SAME TRIANGLE AS PREVIOUS. 
8@ IT@ = ITIPV 


JWK = JWK + 4 


IF (IT@.GT.NT@) GO TO 9¢ 

ITOT3 = ITO*3 

IPl = IPT(ITO@T3-2) 

Xl = XD(IP1) 

Yl = YD(IP1) 

IP2 = IPT(ITOT3-1) 

X2 = XD(IP2) 

Y2 = YD(IP2) 

IF (SIDE(X1,Y1,X2,Y2,X0,Y@) .LT.@.¢) GO 
IP3 = IPT(IT@T3) 

X3 = XD(IP3) 

Y3 = YD(IP3) 

IF (SIDE(X2,Y2,X3,Y3,X0,Y@) .LT.@.@) GO 
IF (SIDE(X3,Y¥3,X1,Y1,X@,Y@) .LT.@.@) GO 
GO TO 17¢ 


C CHECKS IF ON THE SAME BORDER LINE SEGMENT. 


99 


IL1 = ITQ@/NTL 

IL2 = IT@ - ILI*NTL 
ILIT3 = IL1*3 

IP1 = IPL(IL1T3-2) 


Xl = XD(IPL) 
Yl = YOCIPL) 
IP2 = IPL(IL1T3-1) 
X2 = XD(IP2) 


Y2 = YD(IP2) 

IF (IL2.NE.IL1) GO TO 16¢ 

IF (SPDT(X1,Y1,X2,Y2,X@,Y@) .LT.@.06) GO 
IF (SPDT(X2,Y¥2,X1,Y1,X0,Y@) .LT.@.@) GO 
IF (SIDE(X1,Y1,X2,Y2,X@,Y@).GT.@.@) GO 
GO TO 17¢ 


C CHECKS IF BETWEEN THE SAME TWO BORDER LINE 


100 


IF (SPDT (X1,Y1,X2,Y2,X0,Y@) .GT.6.0) GO 
IP3 = IPL(3*IL2-1) 

X3 = XD(IP3) 

Y¥3 = YD(IP3) 

IF (SPDT(X3,Y3,X2,Y2,X0,Y0) .LE.0.@) GO 


C LOCATES INSIDE THE DATA AREA. 


TO 11¢ 


TO 11¢ 
TO 11¢ 


TO 11¢ 
TO 11¢ 
TO 116 


SEGMENTS . 
TO 110 


TO 17¢ 
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880 
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960 

91¢ 

920 

930 

940 
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96¢ 

970 
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990 
160¢ 
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103¢ 
1640 
105@ 
1960 
197@ 
1680 
1690 
1106¢ 
111¢ 
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1140 
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116@ 
1170 
118¢ 
1199 
126¢ 
121¢ 
122¢ 
123¢ 
1246 
12506 
126¢ 
127¢ 
128@ 
129¢ 
136¢ 
131¢ 
132¢ 
1330 
1340 
135¢ 
1360 
1379 
138¢ 
139¢ 
1400 
1416 
142¢ 
143¢ 
1440 
1450 
1460 
1479 
148¢ 
1490 
1500 
151¢ 
1520 
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-~ DETERMINES THE SECTION IN WHICH THE POINT IN QUESTION LIES. 
11@ Isc = 1 

IF (X@.GE.XS1) ISc = Isc + 1 

IF (X@.GE.XS2) ISC = ISC + l 

IF (¥9.GE.Y¥S1) ISC = ISC + 3 

IF (Y@.GE.YS2) ISc = ISC + 3 


- SEARCHES THROUGH THE TRIANGLES ASSOCIATED WITH THE SECTION. 
NTSCI = NTSC(ISC) 
IF (NTSCI.LE.@) GO TO 13¢ 
JIWK = -9 + ISC 
DO 126 ITSC=1,NTSCI 
JIWK = JIWK + 9 
I1@ = IWK(JIWK) 
JWK = IT@*4 
IF (X@.LT.WK(JWK-3)) GO TO 120 
IF (X@.GT.WK(JWK-2)) GO TO 12¢ 
IF (Y¢.LT.WK(JWK-1)) GO TO 12¢ 
IF (Y@.GT.WK(JWK)) GO TO 12¢ 
ITOT3 = ITO*3 
IP] = IPT(ITOT3-2) 
X1 = XD(IP1) 
Yl = YD(IP1L) 
IP2 = IPT(ITOT3-1) 
X2 = XD(IP2) 
Y2 = YD(IP2) 
IF (SIDE(X1,Y1,X2,Y2,X@,Y@) .LT.@.@) GO TO 12¢ 
IP3 = IPT(IT@T3) 
X3 = XD(IP3) 
Y3 = YD(IP3) 
IF (SIDE(X2,Y2,X3,Y3,X@,Y@) .LT.@.6) GO TO 120 
IF (SIDE(X3,Y3,X1,Y1,X0,Y6) .LT.@.@) GO TO 126 
GO TO 17¢ 
120 CONTINUE 
LOCATES OUTSIDE THE DATA AREA. 
12) DO 15¢ IL1=1,NLO 
IL1T3 = IL1*3 
IP1 = IPL(IL1T3-2) 
Xl = XD(IP1) 
Yl = YD(IP1) 
Ip2 = IPL(IL1T3-1) 
X2 = XD(IP2) 
Y2 = YD(IP2) 
IF (SPDT(X2,Y2,X1,Y1,X@,Y@) .LT.@.6) GO TO 15@ 
IF (SPDT(X1,Y1,X2,Y2,X0,Y@) .LT.@.6) GO TO 14¢ 
IF (SIDE(X1,Y1,X2,Y2,X@,Y@) .GT.@.6) GO TO 15@ 
IL2 = IL1 
GO To 16¢ 
149 IL2 = MOD(ILI,NLO) + 1 
IP3 = IPL(3*IL2-1) 
X3 = XD(IP3) 
Y¥3 = YD(IP3) 
IF (SPDT(X3,Y3,X2,Y2,X0,Y@) .LE.0.@) GO TO 16@ 
15@ CONTINUE 
IT = 1 
GO TO 17¢ 
16¢ ITO = ILI*NTL + IL2 
NORMAL EXIT 
170 ITI = IT¢ 
ITIPV = IT? 
RETURN 
END 


SUBROUTINE IDPDRV(NDP,XD,YD,ZD,NCP,IPC,PD) 
THIS SUBROUTINE ESTIMATES PARTIAL DERIVATIVES OF THE FIRST AND 
SECOND ORDER AT THE DATA POINTS. 
THE INPUT PARAMETERS ARE 
NDE = NUMBER OF DATA POINTS, 
XD,YD,ZD = ARRAYS OF DIMENSION NDP CONTAINING THE X, 
Y, AND Z COORDINATES OF THE DATA POINTS, 

NCP = NUMBER OF ADDITIONAL DATA POINTS USED FOR ESTI- 
MATING PARTIAL DERIVATIVES AT EACH DATA POINT, 
INTEGER ARRAY OF DIMENSION NCP*NDP CONTAINING 
THE POINT NUMBERS OF NCP DATA POINTS CLOSEST TO 
EACH OF THE NDP DATA POINTS. 

THE OUTPUT PARAMETER IS 


IPC 
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COLLECTED ALGORITHMS (cont.) 


PD = ARRAY OF DIMENSION 5*NDP, WHERE THE ESTIMATED 
ZX, ZY, ZXX, ZXY, AND ZYY VALUES AT THE DATA 


1 
C 
C POINTS ARE TO BE STORED. 
C DECLARATION STATEMENTS 


DIMENSION XD(1@@) ,YD(16@) ,ZD(14@) , IPC (40) , PD (560) 
REAL NMX, NMY , NMZ , NMXX, NMXY , NMYX , NMYY 


C PRELIMINARY PROCESSING 
1¢ NDP@=NDP 
NCP@=NCP 
NCPM1=NCP@-1 
C ESTIMATION OF ZX AND ZY 
2@ DO 24 IP¢=1,NDPG 

X@=XD (IPQ) 

Y@=YD (IPQ) 

Z6=ZD (IPQ) 

NMKX=@.0 

NMY=¢.0 

NMZ=0.0 

JIPCO=NCPO* (IPG-1) 

DO 23. ICl=1,NCPM1 
JIPC=JIPCG+IC1 
IPI=IPC(JIPC) 

DX1=XD (IPI)-X@ 
DY1=YD (IPL)-Y@ 
DZ1=ZD (IP1)-Z¢ 
IC2MN=IC1+1 
DO 22 IC2=IC2MN,NCP@ 
JIPC=JIPCG+IC2 
IPI=IPC(JIPC) 
DX2=XD (IPL)-x@ 
DY2=YD (IP1)-Y@ 
DNMZ=DX1*DY2-DY1*DX2 
IF (DNMZ.EQ.@.¢@) GO TO 22 
DZ2=ZD(IP1)-z@ 
DNMX=DY1*DZ2-DZ1*DY2 
DNMY=DZ1*DX2-DX1*DZ2 
IF (DNMZ .GE.@.@) GO TO 21 
DNMX=-DNMX 
DNMY=-DNMY 
DNMZ=-DNMZ 
21 NMX=NMX+DNMX 
NMY=NMY+DNMY 
NMZ=NMZ-+DNMZ 
22 CONTINUE 
23 CONTINUE 

JPDO=5* IPO 

PD (JPDO-4) =—NMX/NMZ 

PD (JPDO-3) =-NMY /NMZ 

24 CONTINUE 
C ESTIMATION OF ZXX, ZXY, AND ZYY 
30 DO 34 IP@=1,NDP¢ 

JPDG=JPDO+5 

X@=XD (IPQ) 

JPDO=5* LPO 

Y@=YD (IPQ) 

ZXO=PD (JPDO-4) 

ZYQ=PD ( JPDG-3) 

NMXX=@.@ 

NMXY=9.¢ 

NMYX=@.0 

NMYY=6.0@ 

NMZ =¢.¢ 

JIPCO=NCPO* (IPO-1) 

DO 33. ICl=1,NCPM1 
JIPC=JIPC@+IC1 
IPI=IPC (JIPC) 

DX1=XD (IPI)-x@ 

DY1=YD (IPI)-Y@ 

JPD=5* IPI 

DZX1=PD(JPD-4) -ZX@ 

DZY1=PD(JPD-3)-ZY@ 

IC2MN=IC1+1 

DO 32 IC2=IC2MN,NCP@ 
JIPC=JIPCG+IC2 
IPI=IPC(JIPC) 
DX2=XD (IPL) -x@ 
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COLLECTED ALGORITHMS (cont.) 


DY2=¥D (IPI)-Y@ 

DNMZ =DX1*DY2 -DY1*Dx2 

IF (DNMZ .EQ.@.@) GO TO 32 
JPD=5* IPI 

DZX2=PD (JPD-4) -ZX@ 

DZY2=PD (JPD-3) -ZY@ 

DNMXX=DY 1*DZX2-DZX1*DY2 
DNMXY=DZX1*DX2-DX1*DZX2 
DNMYX=DY 1*DZY2-DZY1*DY2 
DNMYY=DZY1*DX2-DX1*DZY2 

IF (DNii”..GE.0.) GO TO 31 
DNMXX=-DNMKX 

DNMXY=-DN# 7Y 

DNMYX=-DNMiX 


31 NMXX=NMXX+DNMXX 


NMYX=NMYX+DNMYX 
NMYY=NMYY+DNMYY 
NMZ =NMZ +DNMZ 
32 CONTINUE 
33. CONTINUE 
PD (JPD@—-2) =—NMXX /NMZ 
PD (JPDO-1) =— (NMXY+NMYX) / (2 .@*NMZ) 
PD(JPD@) ==-NMYY/NMZ 
34 CONTINUE 
RETURN 
END 


SUBROUTINE IDPTIP(XD,YD,ZD,NT,IPT,NL,IPL,PDD,ITI,XII,YII, 
1 ZII) 
C TKIS SUBROUTINE PERFORMS PUNCTUAL INTERPOLATION OR EXTRAPOLA- 
C TION, I.E., DETERMINES THE Z VALUE AT A POINT. 
C THE INPUT PARAMETERS ARE 
XD,YD,ZD = ARRAYS OF DIMENSiUN NDP CONTAINING THE X, 
Y, AND Z COORDINATES OF THE DATA POINTS, WHERE 
NDP IS THE NUMBER OF THE DATA POINTS, 
NI = NUMBER OF TRIANGLES, 
IPT = INTEGER ARRAY OF DIMENSION 3*NT CONTAINING THE 
POINT NUMBERS OF THE VERTEXES OF THE TRIANGLES, 
NL = NUMBER OF BORDER LINE SEGMENTS, 
IPL = INTEGER ARRAY OF DIMENSION 3*NL CONTAINING THE 


POINT NUMBERS OF THE END POINTS OF THE BORDER 
LINE SEGMENTS AND THEIR RESPECTIVE TRIANGLE 


NUMBERS, 
PDD = APPAY OF DIMENSION 5*NDF CONTAINING THE PARTIAL 
DERIVATIVES AL THE DATA POINTS, 
ITI = TRIANGLE NUMBER OF THE TRIANGLE IN WHICH LIES 
THE POINT FOR WHICH INTERPOLATION IS TO BE 
PERFORMED, 
XII,Y7Z = X AND Y COORDINATES OF THE POINT FOR WHICH 
INTERFOLATION IS TO BE PERFORMED. 
THE OUTPUT PARAMETER IS 
ZII = INTERPOLATED Z VALUE. 
DECLARATION STATEMENTS 


AANANNNAaANAANaANNNaAnNnaANAANaAn 


DIMENSION XD(140),YD(100) ,2D(160) , IPT (585) , IPL(300), 
1 PDD (599) 

COMMON/IDPI/ITPV 

DIMENSION X(3),¥(3),Z(3),PD(15), 

1 2U(3) ,ZV(3) ,ZUU(3) ,ZUV(3) ,ZVV(3) 

REAL LU,LV 


EQUIVALENCE (P5,P5@) 
C PRELIMINARY PROCESSING 
19 IT@="TI 
NTL=NT+NL 
IF (IT@.LE.NTL) 
IL1=IT¢/NTL 
IL2=ITQ@-IL1*NTL 
IF (11.1.EQ.IL2) 
GO TO 6¢ 
C CALCULATION OF ZII BY INTERPOLATION. 
C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED. 
2¢ IF(IT@.EQ.ITPV) GO TO 3¢ 
C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE 


GO TO 2¢ 


GO TO 4¢ 
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COLLECTED ALGORITHMS (cont.) 


C VERTEXES. 
21 JIPT=3* (IT@-1) 
JPD=¢@ 
pO 23 I=1,3 
JIPT=JIPT+1 
IDP=IPT(JIPT) 
X(1I)=XD(IDP) 
¥ (1)=YD (IDP) 
Z(1)=ZD (CIDP) 
JPDD=5* (IDP-1) 
DO 22 KPD=1,5 
JPD=JPD+1 
JPDD=JPDD+1 
PD(JPD)=PDD (JPDD) 
22 CONTINUE 
23 CONTINUE 
C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM 
C TRANSFORMATION FROM THE X-Y SYSTEM TO THE U-V SYSTEM 
C AND VICE VERSA. 
24 XO=X(1) 
Y@=¥ (1) 
A=X (2)-X@ 
B=X (3) -X@ 
C=Y(2)-Y@ 
D=Y (3)-Y@ 
AD=A*D 
BC=B*C 
DLT=AD-—BC 
AP= D/DLT 
BP=-B/DLT 
CP=-C/DLT 
DP= A/DLT 
C CONVERTS THE PARTIAL DERIVATIVES AT THE VERTEXES OF THE 
C TRIANGLE FOR THE U-V COORDINATE SYSTEM. 
25 AA=A*A 
ACT2=2.@*A*C 
CC=C*C 
AB=A*B 
ADBC=AD+BC 
CD=C*D 
BB=B*B 
BDT2=2.@*B*D 
DD=D*D 
DO 26 I=1,3 
TPD= 5*1 
ZU (1) =A*PD (JPD-4)+C*PD (JPD-3) 
ZV (L)=B*PD (JPD-4)+D*PD (JPD-3) 
ZUU (L) =AA*PD (JPD-2)+ACT2*PD (JPD-1)+CC*PD (JPD) 
ZUV (L)=AB*PD (JPD—2)+ADBC*PD (JPD-1)+CD*PD (JPD) 
ZVV (L)=BB*PD (JPD-—2)+BDT2*PD (JPD-1)+DD*PD (JPD) 
26 CONTINUE 
C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL. 
27 PO@=Z(1) 
P1@=ZU(1) 
P@1l=ZV(1) 
P2¢=@.5*ZUU(1) 
Pll=ZUV(1) 
PG2=@.5*ZVV(1) 
H1=Z (2) -P¢@-P10-P2¢ 
H2=ZU (2) -P16-zUU (1) 
H3=ZUU (2) -ZUU (1) 
P3G= 10.0*H1-4.@*H2+0.5*H3 
P4¢=-15 .O*H1+7 .G*H2 -H3 
P5¢@= 6.0*H1-3.0*H2+0.5*H3 
H1=Z (3) -PG¢-PG1-PO2 
H2=ZV (3)-P@1-ZVV(1) 
H3=ZVV(3)-ZVV(1) 
PO3= 106.0*H1-4 .O*H2+0 .5*H3 
PQ4=-15 .O*H1+7 .G*H2 -H3 
P@5= 6.0*H1-3.0*H2+0.5*H3 
LU=SQRT (AA+CC) 
LV=SQRT (BB+DD) 
THXU=ATAN2 (C,A) 
THUV=ATAN2 (D , B) -THXU 
CSUV=COS (THUV) 
P41=5.@*LV*CSUV/LU*P5¢ 
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COLLECTED ALGORITHMS (cont.) 


P14=5 .O*LU*CSUV/LV*PQ5 

H1=ZV (2)-P@1-P11-P41 
H2=ZUV(2)-P11-4.0*P41 

P21l= 3.@*H1-H2 

P31=-2.@*H1+H2 

H1=ZU (3)-P1@-P11-P14 
H2=ZUV(3)-P11-4.Q*P14 

P12= 3.@*H1-H2 

P13=-2.@*H1+H2 
THUS=ATAN2 (D-C , B-A) -THXU 
THSV=THUV-THUS 

AA= SIN(THSV) /LU 

BB=-COS (THSV) /LU 

CC= SIN(THUS)/LV 

DD= COS(THUS)/LV 

AC=AA*CC 

AD=AA*DD 

BC=BB*CC 
G1=AA*AC* (3 .O*BC+2 .G*AD) 
G2=CC*AC* (3 .Q*AD+2 .*BC) 
H1=~AA*AAKAAX (5 . O*AA*BB*P50+ (4. O*BC+AD)*P41) 
1 = -CC*CC*CC* (5 .O*CCADD*PO5+(4 .O*AD+BC)*P14) 
H2=0.5*ZVV(2)-P@2-P12 
H3=@.5*ZUU (3) -P2¢-P21 

P22= (G1*H2+G2*H3-H1) / (G1+G2) 
P32=H2-P22 

P23=H3-P22 

ITPV=1TO 

C CONVERTS XII AND YII TO U-V SYSTEM. 

30 DX=XII-x¢ 
DY=YII-Y@ 

U=AP*DX+BP*DY 
V=CP*DX+DP*DY 
C EVALUATES THE POLYNOMIAL. 

31 PG=POG+V* (PG1+V* (PO2+V* (PO3+V* (PO4+V*PO5) ))) 
Pl=P1G+V* (P11+V* (P12+V* (P13+V*P14))) 
P2=P2G+V* (P21+4+V* (P22+V*P23) ) 

P3=P3¢+V* (P31+V*P32) 
P4=PA4G+-V*P41 
ZII=PG+U* (P1+U* (P2+U* (P3+U* (P44U*P5)))) 
RETURN . 
C CALCULATION OF ZII BY EXTRAPOLATION IN THE RECTANGLE. 
C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED. 
46 IF(IT@.EQ.ITPV) GO TO 5¢ 
C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE END 
C POINTS OF THE BORDER LINE SEGMENT. 
41 JIPL=3* (IL1-1) 
JPD=¢ 
pO 43. I=1,2 
JIPL=JIPL+] 
IDP=IPL(JIPL) 
X(1)=XD (IDP) 
Y(1)=YD(IDP) 
Z(1)=ZD(IDP) 
JPDD=5* (IDP-1) 
DO 42 KPD=1,5 


JPD=JPIH+1 
JPDD=JPDD+1 
PD (JPD)=PDD (JPDD) 
42 CONTINUE 
43 CONTINUE 


C DETERMINES THE COEFFICIENTS FOR THE COORDINATE SYSTEM 
C TRANSFORMATION FROm THE X~-Y SYSTEM TO THE U-V SYSTEM 
C AND VICE VERSA. 
44 X@=X(1) 

Y@=Y¥ (1) 

A=Y (2)-Y (1) 

B=X (2)-X(1) 

C=-B 

D=A 

AD=A*D 

BC=B*C 

DLT=AD-BC 

AP= D/DLT 

BP=-B/DLT 

CP=-BP 
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COLLECTED ALGORITHMS (cont.) 


DP= AP 


C CONVERTS THE PARTIAL DERIVATIVES AT THE END POINTS OF THE 
C BORDER LINE SEGMENT FOR THE U-V COORDINATE SYSTEM. 
45 AA@A*A 


ACT2=2 .@*A*C 

CC=C4*C 

AB=A*B 

ADBC#=AD+BC 

CD=C*D 

BB=B*B 

BDT2=2.Q*B*D 

DD=D*D 

DO 46 I=1,2 
JPD=5*1 
ZU (I) =A*PD (JPD-4)+C*PD (JPD-3) 
ZV (1L)=B*PD (JPD-4)+D* PD (JPD-3) 
ZUU (1) =AA*PD (JPD-—2)+ACT2*PD (JPD-1)+CC*PD (JPD) 
ZUV (L)=AB*PD (JPD-2)+ADBC*PD (JPD-1)+CD*PD (JPD) 
ZVV (L)=BB*PD (JPD-2)+BDT2*PD (JPD-1)+DD*PD (JPD) 


46 CONTINUE 
C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL. 
47 PQ@G=2 (1) 
P1@=zU (1) 
POl=ZV(1) 
P2¢=@.5*ZUU (1) 
Pll=ZUV(1) 
PO2=@.5*ZVV(1) 
H1=Z (2)--P@@-PG1-PG2 
H2=ZV (2)-F@1-ZVV(1) 
H3=ZVV (2)-ZVV(1) 
PO3= 10.Q*H1-4.O*H2+6.5*H3 
PO4=-15 .O*H1+7 .O*H2 -H3 
PO5= 6.O*H1-3.0*H2+0.5*H3 
H1=ZU (2)-P1@-P11 
H2=ZUV(2)-P1l 
P12= 3.@*H1-H2 
P13=—2.@*H1+H2 
P21=9.¢ 
P23=~ZUU (2)+ZUU (1) 
P22=~1.5*P23 
ITPV=ITO 
C CONVERTS XII AND YII TO U-V SYSTEM. 
5@ DX=X1I-x@ 
DY=YLI-Y¢ 
U=AP*DX+BP*DY 
V=CP*DX+DP*DY 
C EVALUATES THE POLYNOMIAL. 


51 PO=POG+V* (PG1+V* (PO2+V* (PO3+V* (PO4+V*PO5)) )) 


P1l=P1¢+V* (P11+V* (P12+V*P13) ) 
P2=P2Q+V* (P21+V* (P22+V*P23) ) 
ZII=PQ+U* (P1+U*P2) 

RETURN 


C CALCULATION OF ZII BY EXTRAPOLATION IN THE TRIANGLE. 
C CHECKS IF THE NECESSARY COEFFICIENTS HAVE BEEN CALCULATED. 


69 IF(IT@.EQ.ITPV) GO TO 79 


C LOADS COORDINATE AND PARTIAL DERIVATIVE VALUES AT THE VERTEX 


C OF THE TRIANGLE. 
61 JIPL=3*IL2-2 
IDP=IPL(JIPL) 
X(1)=XD (IDP) 
¥(1)=YN (IDP) 
Z(1)=ZD (CIDP) 
JPDD=5* (IDP-1) 
DO 62 KPD=1,5 
JPDD=JPDD+1 
PD (KPD)=PDD (JPDD) 
62 CONTINUE 
C CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL. 
67 POd=Z (1) 
P1@=PD (1) 
P@1=PD (2) 
P2¢=0 .5*PD (3) 
Pl1=PD (4) 
PO2=¢.5*PD (5) 
ITPV=ITO 
C CONVERTS XII AND YII TO U-V SYSTEM. 
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COLLECTED ALGORITHMS (cont.) 


Cc 


Cc 
Cc 
Cc 
Cc 


agaanananaaaanaaaa AAQAAAAQAAAAQAAANQANAQAARAAANANNAQAANDNAAAARAAAAAADA 


an 


7@ U=XII-xX(1) 

V=YII-¥(1) 
EVALUATES THE POLYNOMIAL. 

71 PG=POG+V* (PG1+V*PO2) 
P1=P1¢+V*P11 
ZII=PG+U* (P1+U*P20) 
RETURN 
END 


SUBROUTINE IDSFFT(MD,NCP,NDP,XD,YD,ZD,NXI,NYI,X1,YI,ZI, 
1 IWK, WK) 
THIS SUBROUTINE PERFORMS SMOOTH SURFACE FITTING WHEN THE PRO- 
JECTIONS OF THE DATA POINTS IN THE X-Y PLANE ARE IRREGULARLY 
DISTRIBUTED IN THE PLANE. 
THE INPUT PARAMETERS ARE 
MD = MODE OF COMPUTATION (MUST BE 1, 2, OR 3), 
1 FOR NEW NCP AND/OR NEW XD-YD, 
2 FOR OLD NCP, OLD XD-YD, NEW XI-YI, 
3 FOR OLD NCP, OLD XD-YD, OLD XI-YI, 
NUMBER OF ADDITIONAL DATA POINTS USED FOR ESTI- 
MATING PARTIAL DERIVATIVES AT EACH DATA POINT 
(MUST BE 2 OR GREATER, BUT SMALLER THAN NDP), 
NDP = NUMBER OF DATA POINTS (MUST BE 4 OR GREATER), 
XD = ARRAY OF DIMENSION NDP CONTAINING THE X 
COORDINATES OF THE DATA POINTS, 
YD = ARRAY OF DIMENSION NDP CONTAINING THE Y 
COORDINATES OF THE DATA POINTS, 
ZD = ARRAY OF DIMENSION NDP CONTAINING THE Z 
COORDINATES OF THE DATA POINTS, 
NXI = NUMBER OF OUTPUT GRID POINTS IN THE X COORDINATE 
(MUST BE 1 OR GREATER), 
NYI = NUMBER OF OUTPUT GRID POINTS IN THE Y COORDINATE 
(MUST BE 1 OR GREATER), 
XI = ARRAY OF DIMENSION NXI CONTAINING THE X 
COORDINATES OF THE OUTPUT GRID POINTS, 
YI = ARRAY OF DIMENSION NYI CONTAINING THE Y 
COORDINATES OF THE OUTPUT GRID POINTS. 
THE OUTPUT PARAMETER IS 
ZI = DOUBLY~DIMENSIONED ARRAY OF DIMENSION (NXI,NYI), 
WHERE THE INTERPOLATED Z VALUES AT THE OUTPUT 
GRID POINTS ARE TO BE STORED. 
THE OTHER PARAMETERS ARE 
IWK = INTEGER ARRAY OF DIMENSION 
MAX@ (31, 27+NCP) *NDP-+NXI*NYI 
USED INTERNALLY AS A WORK AREA, 
WK = ARRAY OF DIMENSION 5*NDP USED INTERNALLY AS A 
+ WORK AREA. 
THE VERY FIRST CALL TO THIS SUBROUTINE AND THE CALL WITH A NEW 


NCP VALUE, A NEW NDP VALUE, AND/OR NEW CONTENTS OF THE XD AND 
YD ARRAYS MUST BE MADE WITH MD=1. THE CALL WITH MD=2 MUST BE 


PRECEDED BY ANOTHER CALL WITH THE SAME NCP AND NDP VALUES AND 
WITH THE SAME CONTENTS OF THE XD AND YD ARRAYS. THE CALL WITH 
MD=3 MUST BE PRECEDED BY ANOTHER CALL WITH THE SAME NCP, NDP, 
NXI, AND NYI VALUES AND WITH THE SAME CONTENTS OF THE XD, YD, 
XI, AND YI ARRAYS. BETWEEN THE CALL WITH MD=2 OR MD=3 AND ITS 
PRECEDING CALL, THE IWK AND WK ARRAYS MUST NOT BE DISTURBED. 
USE OF A VALUE BETWEEN 3 AND 5 (INCLUSIVE) FOR NCP IS RECOM- 
MENDED UNLESS THERE ARE EVIDENCES THAT DICTATE OTHERWISE. 
THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE 
LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS, 
THEREFORE, SYSTEM DEPENDENT. 
THIS SUBROUTINE CALLS THE IDCLDP, IDGRID, IDPDRV, IDPTIP, AND 
IDTANG SUBROUTINES. 
DECLARATION STATEMENTS 

DIMENSION XD(160),YD(10@) ,ZD (100) ,X1(1@1) ,YI(101), 

1 Z1(10201) , IWK(13301) ,WK(50@) 

COMMON/IDP1/ITPV 

DATA LUN/6/ 
SETTING OF SOME INPUT PARAMETERS TO LOCAL VARIABLES. 
(FOR MD=1,2,3) 

16 MDO= 

NCP@=NCP 

NDP@=NDP 

NXI@=NXI 

NYI@=NYI- 


IDG12920 
ID91293@ 
IDG1294@ 
IDG1295¢ 
ID@1296@ 
ID@12970 
IDG12980 
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IDG1368¢ 
IDG13699 
IDG131¢9 
IDG1311¢ 
IDG1312¢ 
IDG1313¢ 
IDG1314¢ 
IDG1315@ 
IDG1316¢ 
IDG1317¢ 
ID$13180 
IDG1319¢ 
1DO1326¢ 
IDG1321¢ 
IDG1322¢ 
1D61323@ 
1DG13240 
1D$1325@ 
1DG1326¢ 
IDG1327¢ 
IDG1328@ 
ID@1329¢ 
1DG13300 
ID¢1331¢ 
1D913320 
1DG1333¢ 
1DG1334@ 
ID@1335¢ 
1DG13360 
1D91337¢ 
1DG1338¢ 
1DG1339¢ 
IDG1340¢ 
ID@1341¢ 
1DG1342¢ 
1DG1343¢ 
1D91344¢ 
IDG1345¢ 
1DG13460 
1D013470 
1DG13489 
IDG1349¢ 
IN913500 
IDG13510 
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IDG1362¢ 
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COLLECTED ALGORITHMS (cont.) 


C ERROR CHECK. 


(FOR MD=1, 


23) 


2@ IF (MD@.LT.1.OR.MDQ@.GT.3) 


21 


22 


23 


IF (NCP@.LT.2.0R.NCP@.GE.NDP@) 


IF (NDP@.LT.4) 


IF (NXI@.LT.1.0R.NYI@.LT.1) 


LF (MD@.GE.2) 
IWK(1)=NCP@ 
IWK(2)=NDP@ 

GO TO 22 
NCPPV=IWK (1) 
NDPPV=IWK (2) 

IF (NCP@.NE.NCPPV) 
LF (NDP@.NE.NDPPV) 
IF (MD@.GE. 3) 
IWK(3)=NX1@ 
IWK (4) =NYI@ 

GO TO 30 
NXIPV=IWK(3) 
NYIPV=IWK(4) 

IF (NXI@.NE.NXIPV) 
IF (NYI@.NE.NYIPV) 


GO TO 21 


GO TO 9¢ 
GO TO 9¢ 
GO TO 23 


GO TO 9¢ 
GO TO 9¢ 


GO TO 9¢ 
GO TO 9¢ 
GO TO 9¢ 
GO TO 9¢ 


C ALLOCATION OF STORAGE AREAS IN THE IWK ARRAY. 
3@ JWIPT=16 


C TRIANGULATES THE X-Y PLANE. 
40 IF (MD@.GT.1) 


1 


JWIWL=6*NDPG+1 
JWNGP@¢=JWIWL~1 
JWIPL=24*NDPG+1 
JWIWP=30*NDPG+1 
JWIPC=27*NDPG+1 


JWIGPG=MAX@ (31, 27+NCP@) *NDPO 


GO TO 5¢ 


(FOR MD=1) 


(FOR MD=1,2,3° 


CALL IDTANG(NDPG,XD,YD,NT, IWK(JWIPT) ,NL, IWK(JWIPL) , 


IWK(5)=NT 
IWK(6)=NL 
IF (NT.EQ.@) 


RETURN 
C DETERMINES NCP POINTS CLOSEST TO EACH DATA POINT. 


5@ IF (MD@.GT.1) GO TO 6¢ 


IWK(JWIWL) , IWK(JWIWP) , WK) 


CALL IDCLDP (NDP@,XD,YD,NCP@, IWK (JWIPC) ) 


IF (IWK(JWIPC) .EQ.@) 


RETURN 


(FOR MD=1)} 


C SORTS OUTPUT GRID POINTS IN ASCENDING ORDER OF THE ‘SRIANGLE 


C NUMBER AND THE BORDER LINE SEGMENT NUMBER. 
60 IF(MD@.EQ.3) 


C INTERPOLATES THE ZI VALUES. 


1 


GO TO 7¢ 


(FOR MD=#1,2) 


CALL IDGRID(XD,YD,NT, IWK(JWIPT) ,NL, IWK(JWIPL) ,NXIO,NYIQ, 
XI, YI, IWK (JWNGPG+1) , IWK (JWIGPG+1)) 
C ESTIMATES PARTIAL DERIVATIVES AT ALL DATA POINTS. 
C (FOR MD=1,2,3) 
7¢ CALL IDPDRV(NDP@,XD,YD,ZD,NCP@, IWK (JWIPC) , WK) 


8 ITPV=¢ 


81 


82 
86 


JIGOMX=¢ 
JIGIMN=NXI@G*NYIG+1 
NNGP=NT+24NL 
DO 89 JNGP=1,NNGP 
ITI=*JNGP 
IF (JNGP .LE.NT) 
IL1=(JNGP-NT+1) /2 
IL2= (JNGP-NT+2) /2 
IF (IL2.GT.NL) 


GO TO 81 


IL2=1 


ITI=IL1* (NT+NL)+IL2 


JWNGP=JWNGPG+JINGP 
NGP@=IWK (JWNGP) 

IF (NGP@ .EQ.@) 
JIGOMN=J LG@MX+1 
JIGOMX=J IGGMX+NGPO 


GO TO 86 


DO 82 JIGP=JIGOMN, JIG@MX 


JWIGP=JWIGPG+JIG 
IZI=IWK (JWIGP) 


P 


IYI=(IZI-1) /NXI¢+1 


IXI=IZI-NXI@* (IY 


I-1) 


(FOR MD=1,2,3) 


CALL IDPTIP(XD,YD,ZD,NT, IWK(JWIPT) ,NL, IWK(JWIPL) ,WK, 
ITL,X1I(IXI) ,YI(IYI) ,ZI(1ZI)) 


CONTINUE 
JWNGP=JWNGPG+2*NNG 
NGP 1=IWK (JWNGP) 

IF (NGP1.EQ.@) 


P+1-JNGP 


GO TO 89 
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COLLECTED ALGORITHMS (cont.) 


C 


C 


2090 FORMAT(1X/41H *** 


QAAQAQAAAAAANRAAARAANDAANANAAGAAANANANANAANAANANNANANANANAAMANAAAAANAAADNA 


JIGIMX=JIGIMN-1 
JIGIMN=JIGIMN-NGP1 
DO 87 JIGP=JIGIMN, JIGIMX 
JWIGP=JWIGP@+JIGP 
IZI=IWK (JWIGP) 
LTYI=(IZI-1) /NXI@+1 
IXI=@IZI-NXIQ@* (IYI-1) 
CALL IDPTIP(XD,YD,ZD,NT, IWK(JWIPT) ,NL, IWK(JWIPL) ,WK, 
1 ITI,XI(IXI) ,YICIYI) ,Z1(1ZI)) 
87. CONTINUE 
89 CONTINUE 
RETURN 
ERROR EXIT 
9% WRITE (LUN, 2090) MD@,NCP@,NDP@,NXI@,NYIO 
RETURN 
FORMAT STATEMENT FOR ERROR MESSAGE 
IMPROPER INPUT PARAMETER VALUE(S)./ 
1 7H MD =,14,1@X,5HNCP =,16,1@X,5HNDP =,16, 
2 1@X,5HNXI =,16,10X,5HNYI =,16/ 
._3 35H ERROR DETECTED IN ROUTINE 
END 


IDSFFT/) 


SUBROUTINE IDTANG(NDP,XD,YD,NT,IPT,NL, IPL, IWL, IWP, WK) 
THIS SUBROUTINE PERFORMS TRIANGULATION. IT DIVIDES THE X-Y 
PLANE INTO A NUMBER OF TRIANGLES ACCORDING TO GIVEN DATA 
POINTS IN THE PLANE, DETERMINES LINE SEGMENTS THAT FORM THE 
BORDER OF DATA AREA, AND DETERMINES THE TRIANGLE NUMBERS 
CORRESPONDING TO THE BORDER LINE SEGMENTS. 

AT COMPLETION, POINT NUMBERS OF THE VERTEXES OF EACH TRIANGLE 
ARE LISTED COUNTER-CLOCKWISE. POINT NUMBERS OF THE END POINTS 
OF EACH BORDER LINE SEGMENT ARE LISTED COUNTER-CLOCKWISE, 
LISTING ORDER OF THE LINE SEGMENTS BEING COUNTER-CLOCKWISE. 
THE LUN CONSTANT IN THE DATA INITIALIZATION STATEMENT IS THE 
LOGICAL UNIT NUMBER OF THE STANDARD OUTPUT UNIT AND IS, 
THEREFORE, SYSTEM DEPENDENT. 
THIS SUBROUTINE CALLS THE IDXCHG FUNCTION. 
THE INPUT PARAMETERS ARE 
NDP = NUMBER OF DATA POINTS, 
XD = ARRAY OF DIMENSION NDP CONTAINING THE 
X COORDINATES OF THE DATA POINTS, 
YD = ARRAY OF DIMENSION NDP CONTAINING THE 
Y COORDINATES OF THE DATA POINTS. 
THE OUTPUT PARAMETERS ARE 
NT = NUMBER OF TRIANGLES, 
IPT = INTEGER ARRAY OF DIMENSION 6*NDP-15, WHERE THE 
POINT NUMBERS OF THE VERTEXES OF THE (IT)TH 
TRIANGLE ARE TO BE STORED AS THE (3*IT-2)ND, 
(3*IT-1)ST, AND (3*IT)TH ELEMENTS, 
TTe1 232425 Nts 
NL = NUMBER OF BORDER LINE SEGMENTS, 
IPL = INTEGER ARRAY OF DIMENSION 6*NDP, WHERE THE 
POINT NUMBERS OF THE END POINTS OF THE (IL)TH 
BORDER LINE SEGMENT AND ITS RESPECTIVE TRIANGLE 
NUMBER ARE TO BE STORED AS THE (3*IL-2)ND, 
(3*IL-1)ST, AND (3*IL)TH ELEMENTS, 
Eel 62 vce NEw 
THE OTHER PARAMETERS ARE 
IWL = INTEGER ARRAY OF DIMENSION 18*NDP USED 
INTERNALLY AS A WORK AREA, 
IWP = INTEGER ARRAY OF DIMENSION NDP USED 
INTERNALLY AS A WORK AREA, 
WK = ARRAY OF DIMENSION NDP USED INTERNALLY AS A 
WORK AREA. 
DECLARATION STATEMENTS 
DIMENSION XD(16@),YD(10@),IPT(585) ,IPL(60¢), 
1 IWL (1800) , WP (160) , WK (1060) 
DIMENSION ITF(2) 
DATA RATIO/1.@E-6/, NREP/106/, LUN/6/ 
STATEMENT FUNCTIONS 

DSQF(UL,V1,U2,V2)=(U2—U1) **2+(V2-V1)**2 

SIDE(U1,V1,U2,V2,U3,V3)=(V3-V1)* (U2-U1) -(U3-U1)* (V2-V1) 
PRELIMINARY PROCESSING 

16 NDP@=NDP 

NDPM1=NDP@-1 

IF (NDP@.LT. 4) GO TO 9¢ 
DETERMINES THE CLOSEST PAIR OF DATA POINTS AND THEIR MIDPOINT. 

2@ DSQMN=DSQF (XD(1),YD(1) ,XD(2) ,YD(2)) 
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COLLECTED ALGORITHMS (cont.) 


IPMN] =1 
IPMN2=2 
DO 22 IP1=1,NDPM1 
X1=XD (IP 1) 
Y1=YD(IP1) 
IPIP1=IP1+1 
DO 21 IP2=IP1P1,NDP@ 
DSQI=DSQF(X1,Y1,XD(IP2) ,YD(IP2)) 
IF (DSQI.EQ.@.@) GO TO 91 
IF (DSQI.GE.DSQMN) GO TO 21 
DSQMN=DSQI 
IPMN1=IP1 
IPMN2=IP2 
21 CONTINUE 
22 CONTINUE 
DSQ12=DSQMN 
XDMP= (XD (IPMN1)+XD(IPMN2) )/2.¢ 
YDMP= (YD (IPMN1)+YD(IPMN2))/2.¢ 
C SORTS THE OTHER (NDP-2) DATA POIN’S IN ASCENDING ORDER OF 


C DISTANCE FROM THE MIDPOINT AND STORES THE SORTED DATA POINT 


C NUMBERS IN THE IWP ARRAY. 
30 JP1=2 
DO 31 IPl=1,NDP¢ 
IF(IP1.EQ.IPMN1.OR.IP1.EQ.IPMN2) 
JP1l=JP1+1 
IWP (JP1)=IP1 
WK(JP1)=DSQF (XDMP ,YDMP,XD(IP1),YD(IP1)) 
31 CONTINUE 
DO 33. JP1=3,NDPM1 
DSQMN=WK (JP1) 
JPMN=JP1 
DO 32 JP2=JP1,NDPO 
IF (WK(JP2) .GE.DSQMN) 
DSQMN=WK (JP2) 
JPMN=JP2 
32 CONTINUE 
ITS=IWP (JP1) 
IWP (JP1)=IWP (JPMN) 
IWP (JPMN)=ITS 
WK (JPMN) =WK(JP1) 
33 CONTINUE 
C IF NECESSARY, MODIFIES THE ORDERING IN SUCH A WAY THAT THE 
C FIRST THREE DATA POINTS ARE NOT COLLINEAR. 
35 AR=DSQ12*RATIO 
X1=XD (IPMN1) 
Y1=YD (IPMN1) 
DX21=XD (IPMN2)-X1 
DY¥21=YD (IPMN2)-Y1 
DO 36 JP=3,NDPO 
IP=IWP (JP) 
LF (ABS ((YD(IP)-Y1)*DX21-(XD(IP)-X1)*DY21) .GT.AR) 
GO TO 37 


GO TO 31 


GO TO 32 


36 CONTINUE 
GO TO 92 
37 IF (JP.EQ.3) 
JPMX=JP 
JP=JPMX+1 
DO 38 JPC=4,JPMX 
JP=JP=1 
LWP (JP) =IWP (JP-1) 
38 CONTINUE 
IWP (3)=IP 


GO TO 4¢ 


C FORMS THE FIRST TRIANGLE. STORES POINT NUMBERS OF THE VER- 
C TEXES OF THE TRIANGLE IN THE IPT ARRAY, AND STORES POINT NUM- 
C BERS OF THE BORDER LINE SEGMENTS AND THE TRIANGLE NUMBER IN 


C THE IPL ARRAY. 
46 IP1=IPMN1 
IP2=IPMN2 
IP3=IWP (3) 


IF (SIDE(XD(IP1) ,YD(IP1) ,XD(IP2) ,YD(IP2) ,XD(1P3) ,YD(IP3)) 


1 .GE..0) GO TO 41 
IP1=IPMN2 
IP2=IPMN1 

41 NT@=1 
NTT3=3 


IPT(1)=IP1 
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COLLECTED ALGORITHMS (cont.) 


IPT(2)=IP2 
IPT (3)=IP3 
NLG=3 
NLT3=9 
IPL(1)=IP1 
IPL(2)=IP2 
IPL(3)=1 
IPL(4)=IP2 
IPL(5)=IP3 
IPL(6)=1 
IPL(7)=IP3 
IPL(8)=IP1 
1PL(9)=1 
C ADDS THE REMAINING (NDP—3) DATA POINTS, ONE BY ONE. 
5@ DO 79 JP1=4,NDP@ 
IP1=IWP (JP1) 
X1=XD(IP1) 
Yl=YD(IP1) 
C - DETERMINES THE VISIBLE BORDER LINE SEGMENTS. 
IP2=IPL(1) 
JPMN=1 
DXMN=XD (IP2)-X1 
DYMN=YD (IP2)-Y1 
DSQMN=DXMN** 2+DYMN** 2 
ARMN=DSQMN*RATIO 
JPMX=1 
DXMX=DXMN 
DYMX=DYMN 
DSQMK=DSQMN 
ARMX=ARMN 
DO 52 JP2=2,NL@ 
IP2=IPL(3*JP2-2) 
DX=XD (IP2)-X1 
DY=YD (IP2)-Y1 
AR=DY*DXMN-DX*DYMN 
IF (AR.GT.ARMN) GO TO 51 
DSQI=DX**2+DY**2 
IF (AR.GE. (-ARMN) .AND .DSQI.GE.DSQMN) GO TO 51 
JPMN=JP2 
DXMN=DX 
DYMN=DY 
DSQMN=DSQI 
ARMN=DSQMN*RATIO 
51 AR=DY*DXMX-DX*DYMX 
IF (AR.LT. (-ARMX)) GO TO 52 
DSQI=DX**24+DY** 2 
IF (AR.LE.ARMX.AND .DSQI.GE.DSQMX) GO TO 52 
JP? Y=JP2 
DXMX=DX 
DYMX=DY 
DSQMX=DSQI 
ARMX=DSQMX*RATIO 
52 CONTINUE 
IF(JPMX.LT.JPMN) JPMX=JPMX+NL@ 
NSH=JPMN-1 
IF (NSH. LE.@) GO TO 6¢@ 
C — SHIFTS (ROTATES) THE IPL ARRAY TO HAVE THE INVISIBLE BORDER 
C - LINE SEGMENTS CONTAINED IN THE FIRST PART OF THE IPL ARRAY. 
NSHT3=NSH*3 
DO 53. JP2T3=3,NSHT3,3 
JP3T3=JP2T3+NLT3 
IPL (JP3T3-2)=*IPL(JP2T3-—2) 
IPL(JP3T3-1)=IPL(JP2T3-1) 
IPL(JP3T3) =IPL(JP2T3) 
53 CONTINUE 
DO 54 JP2T3=3,NLT3,3 
JP3T3=JP2T3+NSHT3 
IPL(JP2T3-2)=IPL(JP3T3-2) 
IPL(JP2T3-1)=IPL(JP3T3-1) 
IPL(JP2T3) =IPL(JP3T3) 
54 CONTINUE 
JPMX=JPMX-NSH 
C - ADDS TRIANGLES TO THE IPT ARRAY, UPDATES BORDER LINE 
C - SEGMENTS IN THE IPL ARRAY, AND SETS FLAGS FOR THE BORDER 
C - LINE SEGMENTS TO BE REEXAMINED IN THE IWL ARRAY. 
66 JWL=¢ 


IDO16¢8¢ 
IDG16690 
IDG1610¢ 
IDO1611¢ 
1DG1612¢ 
IDG1613¢ 
IDG1614¢ 
ID@1615¢@ 
IDO1616¢ 
ID@1617@ 
IDG1618¢ 
IDG1619¢ 
IDQ1620¢ 
ID@1621¢ 
1DG1622¢ 
IDG1623¢ 
ID@16240 
ID@1625¢ 
IDG1626¢ 
1DG1627¢ 
IDG1628¢ 
IDG1629¢ 
IDG1630¢ 
1D$1631¢ 
IDG1632¢ 
ID@1633¢ 
IDQG1634¢ 
1DG1635@ 
IDG1636@ 
IDG1637@ 
IDO1638¢ 
IDQ1639¢ 
IDO16400 
IDG1641¢ 
IDG1642¢ 
IDG1643¢ 
ID$1644¢ 
IDQ@1645¢ 
1D61646¢ 
IDG16476 
IDG1648¢ 
IDG1649¢ 
IDG1650¢ 


ID@1651 
1pb18238 


IDQ16530 
IDG1654¢ 
1D¢1655@ 
ID@1656¢@ 
IDG1657@ 
IDG1658¢ 
ID@1659¢@ 
IDG16600 
IDG1661¢ 
ID@1662¢ 
IDQG16630 
IDG16640 
IDG1665¢ 
IDG1666¢ 
IDG1667¢ 
IDG1668¢ 
IDG1669¢ 
IDO16706¢ 
IDG1671¢ 
ID@1672¢ 
I1DQ1673@ 
IDO1674¢ 
1DG1675@ 
IDG1676¢ 
ID¢1677@ 
IDO1678¢ 
ID¢1679¢ 
IDO1686¢ 
IDG1681¢ 
IDG$16826 
ID$1683¢ 
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DO 64 JP2=JPMX,NLO 
JIP2T3=JP2*3 
IPL1=IPL(JP2T3-2) 
IPL2=IPL(JP2T3-1) 
IT =IPL(JP2T3) 

C - - ADDS A TRIANGLE TO THE IPT ARRAY. 
NIG=NTO+1 
NIT3=NTT3+3 
IPT (NTT3-2) =IPL2 
IPT (NTT3-1)=IPL1 
IPT(NTT3) =IP1 


C - - UPDATES BORDER LINE SEGMENTS IN THE IPL ARRAY. 


IF (JP2.NE.JPMX) 
IPL(JP2T3-1)=IP1 
IbL(JP2T3) =NTO 
61 IF (JP2.NE.NLO) 
NLN=JPMX+1 
NLNT3=NLN*3 
IPL(NLNT3-2)=IP1 
IPL(NLNT3-1)=IPL(1) 
IPL(NLNT3) =NTO 


GO TO 61 


GO TO 62 


C - — DETERMINES THE VERTEX THAT DOES NOT LIE ON THE BORDER 


C - - LINE SEGMENTS. 
62 ITT3=1T*3 
IPTI=IPT(ITT3-2) 
IF(IPTI.NE.IPL1.AND.IPTI.NE.IPL2) 
IPTI=IPT(ITT3-1) 
IF(IPTI.NE.IPL1.AND.IPTI.NE.IPL2) 
IPTI=IPT (ITT3) 
C - - CHECKS IF THE EXCHANGE IS NECESSARY. 
63 IF (IDXCHG (XD, YD, IP1,IPTI,IPL1,IPL2) .EQ.@) 
C - - MODIFIES THE IPT ARRAY WHEN NECESSARY. 
IPT (ITT3-2)=IPTI 
IPT (ITT3-1)=IPL1 
TPT(ITT3) =IP1 
IPT (NTT3-1)=IPTI 
IF (JP2.EQ.JPMX) IPL(JP2T3)=IT 
IF (JP2.EQ.NL@.AND.IPL(3) .EQ.1T) 
C - - SETS FLAGS IN TNE IWL ARRAY. 
JWL=JWL+4 
IWL(JWL-3)=IPL1 
IWL (JWL-2)=IPTI 
IWL (JWL-1)=IPTI 
IWL(JWL) =IPL2 
64 CONTINUE 
NLG=NLN 
NLT 3=NLNT3 
NLF=JWL/2 
IF (NLF .EQ.) GO TO 79 
C - IMPROVES TRIANGULATION. 
70 = NTT3P3=NTT3+3 
DO 78 IREP=1,NREP 
DO 76 ILF=1,NLF 
ILFL2=ILF*2 
LPL1=IWL(ILFT2=1) 
IPL2=IWL (ILFT2) 


GO TO 65 


GO TO 65 


IPL(3)=NTO 


GO TO 64 


C - - LOCATES IN THE IPT ARRAY TWO TRIANGLES ON BOTH SIDES OF 


C - - THE FLAGGED LINE SEGMENT. 
NIF=¢ 
DO 71 ITT3R=3,NTT3,3 
ITT3=NTT3P3-ITT3R 
IPT1=IPT(ITT3-2) 
IPT2=IPT (ITT3-1) 
IPT3=IPT (ITT3) 
IF(IPL1.NE.IPT1.AND.IPL1.NE.IPT2.AND. 
1 IPL1.NE.IPT3) GO TO 71 
IF (IPL2.NE.IPT1.AND.IPL2.NE.IPT2.AND. 
1 IPL2.NE.IPT3) GO TO 71 
NTF=NTF+1 
ITF (NTF)=ITT3/3 
IF (NTF .EQ. 2) 
71 CONTINUE 
IF (NTF .LT. 2) 


GO TO 72 


GO TO 76 


C - — DETERMINES THE VERTEXES OF THE TRIANGLES THAT DC! NOT LIE 


C - - ON THE LINE SEGMENT. 
72 ITLT3=ITF (1)*3 


IDG1684¢ 
IDG1685¢ 
IDG1686¢ 
ID@16870 
IDQ16880 
IDG16890 
1D916900 
ID@1691@ 
1ID91692¢ 
ID91693¢ 
IDG1694¢@ 
IDG1695¢ 
IDQ1696¢ 
IDQ@1697¢ 
IDG16980 
ID@1699¢ 
IDQ17060 
IDG17461¢@ 
ID@1762¢ 
1D917¢3¢ 
IDG17040 
ID@17@506 
IDG17G6¢ 
IDQ17676 
IDG17680 
1DG1769¢ 
IDG171¢6¢ 
ID@1711¢ 
IDG1712¢ 
IDG1713¢ 
ID@1714@ 
ID@1715¢ 
IDQ@17160 
IDQ1717¢ 
IDG1718¢ 
ID@1719¢ 
IDG17200 
IDG17210 
IDG1722@ 
1D91723@ 
IDG1724¢ 
ID@1725¢ 
IDQ1726¢ 
IDG1727@ 
ID@1728¢ 
IDG1729¢ 
ID@17300 
ID@1731¢ 
1D$1732¢ 
1D¢1733¢ 
ID@1734¢ 
ID@1735@ 
IDG1736¢ 
ID@17370 
IDG1738¢ 
1D¢1739¢ 
IDO1740¢@ 
ID@1741¢ 
ID@17420 
1DG1743¢ 
IDG1744¢ 
ID@1745¢ 
IDO1746¢ 
ID@1747¢ 
IDG1748¢ 
1D¢1749¢ 
1DO17560 
ID@1751¢ 
IDG1752¢ 
1D¢1753¢ 
ID@1754@ 
ID@1755¢ 
ID@1756¢@ 
ID617570 
IDG1758¢ 
ID@1759¢ 
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IPTI1=IPT (IT1T3-2) 


IF (IPTI1.NE.IPL1.AND.IPTI1.NE.IPL2) GO TO 73 
IPTIL=IPT (ITIT3-1) 
LF(IPTI1.NE.IPL1.AND.IPTI1.NE.IPL2) GO TO 73 
IPTI1=IPT (IT1T3) 
73 IT2T3=ITF(2)*3 
IPTI2=IPT(IT2T3-2) 
IF (IPTI2.NE.IPL1.AND.IPTI2.NE.IPL2) GO TO 74 
IPTI2=IPT (IT2T3-1) 
IF (IPTI2.NE.IPL1.AND.IPTI2.NE.IPL2) GO TO 74 
IPTI2=IPT (IT2T3) 
C - - CHECKS IF THE EXCHANGE IS NECESSARY. 
74 LF (IDXCHG (XD, YD, IPTI1 ,IPTI2,IPL1,IPL2) .EQ.@) 
1 GO TO 76 
C - - MODIFIES THE IPT ARRAY WHEN NECESSARY. 


IPT (IT1T3-2)=IPTI1 
IPT (ITIT3-1)=IPTI2 
IPT(IT1T3) =IPLI1 
IPT (IT2T3-2)=IPT12 
IPT (IT2T3-1)=IPTI1 
IPT(IT2T3) =IPL2 
C - - SETS NEW FLAGS. 
JWL=JWL+8 
IWL (JWL-7)=IPL1 
IWL (JWL-6)=IPTI1 
IWL(JWL-5)=IPTI1 
IWL (JWL-4)=IPL2 
IWL (JW.-3) =IPL2 
IWL (J*iL-2)=IPTI2 
IWL (JWL-1)=IPTI2 
IWL(JWL) =IPL1 
DO 75 JLT3=3,NLT3,3 
IPLJ1=IPL(JLT3-2) 
IPLJ2=IPL(JLT3-1) 
IF ((IPLJ1.EQ.IPL1.AND.IPLJ2.EQ.IPTI2).OR. 
i (IPLJ2.EQ.IPL1.AND.IPLJ1.EQ.IPTI2)) 
2 IPL(JLT3)=ITF (1) 
IF((IPLJ1.EQ.IPL2.AND.IPLJ2.EQ.IPTI1).OR. 
(IPLJ2.EQ.IPL2.AND.IPLJ1.EQ.IPTI1)) 
2 IPL(JLT3)=ITF (2) 
75 CONTINUE 
76 CONTINUE 
NLFC=NLF 
NLF=JWL/2 
IF (NLF .EQ.NLFC) GO TO 79 
C ~ - RESETS THE IWL ARRAY FOR THE NEXT ROUND. 
JWL=@ 
JWLIMN=(NLFC+1)*2 
NLFT2=NLF* 2 
DO 77. JWLI=JWLIMN,NLFT2,2 
JWL=JWL+2 
IWL (JWL-1)=IWL(JWL1-1) 
IWL(JWL) =IWL(JWL1) 
77 CONTINUE 
NLF=JWL/2 
78 CONTINUE 
79 CONTINUE 
C REARRANGES THE IPT ARRAY SO THAT THE VERTEXES OF EACH TRIANGLE 
C ARE LISTED COUNTER-CLOCKWISE. 
8@ DO 81 ITT3=3,NTT3,3 
IP1=IPT (ITT3-2) 
IP2=IPT(ITT3-1) 


i 


IP3=IPT(ITT3) 
IF (SIDE(XD(IP1) ,YD(IP1) ,XD(IP2) ,YD(IP2) ,XD(IP3) ,YD(IP3)) 
1 .GE.0.9) GO TO 81 


IPT (ITT3-2)=I1P2 
IPT (ITT3-1)=IP1 
81 CONTINUE 
NT=NTO@ 
NL=NL@ 
RETURN 
C ERROR EXIT 
9% WKITE (LUN,2¢9¢) NDP@ 
GO TO 93 
91 WRITE (LUN, 2091) 
GO TO 93 


NDP, IP1,1P2,X1,Y1 


ID@176¢0 
ID@1761¢ 
ID@1762¢ 
1D$1763¢ 
IDG1764@ 
1D01765¢ 
ID@1766¢ 
1D@1767@ 
ID@1768¢0 
IDQ@17690 
IDG1770¢ 
IDG1771¢ 
IDG1772¢ 
1D¢1773¢ 
IDG1774¢ 
ID@17750 
ID@1776¢ 
ID¢17770 
IDG1778@ 
ID@1779¢ 
IDG1780¢ 
IDG1781¢ 
ID@1782¢ 
IDQ1783¢ 
IDG1784¢ 
ID¢17856 
IDQ1786¢ 
1ID¢17870 
IDG1788¢ 
ID@1789¢ 
IDG1790¢ 
ID@1791¢ 
1DG1792¢ 
ID¢1793¢ 
ID@1794¢ 
IDG1795@ 
IDQ1796¢ 
ID¢1797¢ 
ID¢1798¢ 
ID¢1799¢ 
IDG1860¢ 
ID@G18¢1¢ 
ID@180290 
IDG1803¢ 
IDO18640 
IDG1865¢ 
IDG18¢6¢ 
IDG1807¢ 
IDG1808¢ 
IDG1869¢ 
IDG1810¢0 
IDG1811¢ 
ID@1812¢ 
ID@1813¢ 
IDG1814¢ 
ID@1815@ 
IDG1816¢ 
ID91817¢@ 
ID@1818¢ 
IDG1819¢ 
IDG1820¢ 
ID@1821¢ 
ID@1822¢ 
1DG1823¢ 
IDQ@1824¢ 
ID@1825@ 
IDQ@1826¢ 
ID@18270 
ID@1828¢ 
ID@1829¢ 
IDG18306¢ 
ID$1831¢ 
ID@18320 
IDG$1833¢ 
ID@1834¢ 
IDG1835¢@ 
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Cc 


AARANRAANANAANAANAN 


92 WRITE (LUN,2692) NDP@ 
93 WRITE (LUN, 2693) 
NT=¢ 
RETURN 
FORMAT STATEMENTS 
209% FORMAT (1X/23H *** 
2991 FORMAT(1X/29H *** 
1 8H 
2 5X,4HXD =,E12.4,5X,4HYD =,E£12.4) 
2492 FORMAT(1X/33H *** 
1 8H NDP =,I5) 
2093 FORMAT(35H ERROR DETECTED IN ROUTINE 
END 


NDP LESS THAN 4./8H 


FUNCTION IDXCHG(X,Y,11,12,13,14) 


THIS FUNCTION DETERMINES WHETHER OR NOT THE EXCHANGE OF TWO 
TRIANGLES IS NECESSARY ON THE BASIS OF MAX-MIN-ANGLE CRITERION 
BY C. L. LAWSON. 
THE INPUT PARAMETERS ARE 
X,Y = ARRAYS CONTAINING THE COORDINATES OF THE DATA 
POINTS, 
11,12,13,14 = POINT NUMBERS OF FOUR POINTS Pl, ?2, 
P3, AND P4 THAT FORM A QUADRILATERAL WITH P3 
AND P4 CONNECTED DIAGONALLY. 
THIS FUNCTION RETURNS AN INTEGER VALUE 1 (ONE) WHEN AN EX- 
CHANGE IS NECESSARY, AND @ (ZERO) OTHERWISE. 
DECLARATION STATEMENTS 
DIMENSION X(106),¥(100) 
EQUIVALENCE (C2SQ,C1SQ), (A3SQ, B2SQ), (B3SQ,A1SQ), 
1 (A4SQ,B1SQ) , (B4SQ,A2SQ) , (C4SQ,C3S8Q) 
PRELIMINARY PROCESSING 
16 X1=X(1I1) 
Y1l=Y (11) 
X2=X (12) 
Y2=Y (12) 
X3=X (13) 
Y3=¥ (13) 
X4=X (14) 
Y¥4ey (14) 
CALCULATION 
2@ IDX=¢ 


U3= (Y¥2-Y3)* (X1-X3)-(X2-X3)* (Y1-Y3) 

U4= (Y1-Y4)* (K2-X4) -(X1-X4) * (Y2-Y4) 

LF (U3*U4.LE.@.@) GO TO 3¢ 

Ul=(¥3-Y1)* (X4-X1)-(X3-X1)* (¥4-Y1) 

U2= (Y4-Y2)* (X3-X2)—(X4-X2) * (Y3-¥2) 

A1SQ=(X1-X3)*#*2+(Y1-Y3) **2 

B1SQ=(X4—X1)**2+(Y4-Y1)**2 

C1SQ= (X3-K4) **2+(Y3-Y4)**2 

A2SQ= (X2-X4) ** 2+ (Y2-Y4) **2 

B2SQ=(X3-K2) **2+(Y3-¥2)**2 

C3SQu (X2—-X1)**2+(Y2-Y1) **2 

$1SQ=U1*U1/ (C1SQ*AMAX1 (A1SQ,B1SQ) ) 

$2SQ=U2*U2/ (C2SQ*AMAX1 (A2SQ, B2SQ) ) 

$3SQ0=U3*U3/ (C3SQ*AMAX1 (A3S0,B3SQ) ) 

S4SQ=U4*U4/ (C4SQ*AMAX1 (A4SQ, B4SQ)) 

IF (AMIN1 (S18Q,$2SQ) .LT.AMINI (S3SQ,$45Q)) 
3@ IDXCHG=IDX 

RETURN 

END 


NDP =,15) 


IDENTICAL DATA POINTS./ 
NDP =,15,5X,5HIP1 =,15,5X,5HIP2 =,15, 


ALL COLLINEAR DATA POINTS./ 


IDTANG/) 


T0x=1 
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REMARK ON ALGORITHM 526 


Bivariate Interpolation and Smooth Surface Fitting for Irregularly Distributed 
Data Points [E1] 
[H. Akima, ACM Trans. Math. Software 4, 2 (June 1978), 160-164] 


-Hiroshi Akima [Recd 19 December 1978] 
U.S. Department of Commerce, National Telecommunications and Information 
Administration, Institute for Telecommunication Sciences, Boulder, CO 80303 


In Section 10.2.6, ANSI Standard Fortran provides that the completion of 
execution of a RETURN statement in a subprogram causes all local variables in 
that subprogram to become undefined. Some of the subprograms in Algorithm 
526, however, are dependent on the retention of values by local variables. The 
algorithm, therefore, will fail to work properly if the above provision is strictly 
enforced as in the case where the “reset own” option is used on the Burroughs 
B6700 computer. 

Illegal use of undefined local variables will take place in the following cases: 

(1) in IDBVIP when called with MD = 2 or 3; 

(2) in IDSFFT when called with MD = 2 or 3; 

(3) in IDLCTN when IDBVIP is called with NIP > 1; 

(4) in IDPTIP when IDBVIP is called with NIP > 1; 

(5) in IDPTIP when [IDSFFT is called with NXI > 1 and/or NYI > 1. 

Cases (1) and (2) can be corrected by resetting two integer variables in IDBVIP 
and IDSFFT, respectively. Case (3) can be corrected by combining a local integer 
variable with another integer variable in a COMMON area shared by IDBVIP 
and IDLCTN, and by placing 13 real variables in the same COMMON area. 
Cases (4) and (5) can be corrected by placing 27 real variables in a COMMON 
area shared by IDBVIP, IDPTIP, and IDSFFT. (Corresponding to the last 
correction, some additional minor changes are required in IDPTIP.) These 
corrections require no changes for the program that calls IDBVIP and/or 
IDSFFT. 

Specifically, the following replacement, insertion, and deletion should be made: 


TOI IOC A Kk REQUIRED CHANGES IN ACM ALGORITHM 526 FOO IR It 


**k* = IDBVIP = *#** 


COMMON/IDLC/ITIPV , DMMY1 (13) ID001880 

COMMON/IDPI/ITPV , DMMY (27) IDO001890 

40 IF (MDO.GT.1) GO TO 41 ID002240 

GO TO 50 IDO002291 

41 NT=IWK(5) ID002292 

NL=IWK (6) ID002293 

ITIPV=0 ID002370 
KKK IDLCTN kkk 

DIMENSION IDSC (9) IDL 370 

COMMON/IDLC/ITIPV ,XS1,XS2,YS1,YS2,NTSC (9) IDL 380 

IF (ITIPV.NE. 0) GO TO 80 IDL 500 

Cc NIT=1 EAE THIS LINE SHOULD BE DELETED. ill IDL 510 
**k = =IDPTIP *** 

COMMON/IDPI/ITPV,X0,Y0,AP,BP,CP,DP, ID010470 

1 PO0O,P10,P20,P30,P40,P50,P01,P11,P21,P31,P41, ID010471 

2 P02,P12,P22,P32,P03,P13,P23,P04,P14,P05 ID010472 

XO=XD (IDP) ID012750 

YO=YD (IDP) ID012760 

ZO=ZD (IDP) ID012770 

67 POO=Z0 ID012840 

70 U=XII-xXO ID012920 

V=YII-yYO ID012930 
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eke) IDSFFT =—-#** 


COMMON/IDPI/ITPV ,DMMY (27) Ip013640 
40 IF (MDO.GT.1) GO TO 41 ID014030 
GO TO 50 ID014081 
41 NT=IWK(5) ID0O14082 
NL=IWK (6) ID014083 


KIRK KKKREKKE EKER EK EKER KEK KKK KKK KEE RRR KRKKEKREKRKI EKER KKK KERR KEK KER EEKEKKEKK KK KK KAR 


After these changes are made, the algorithm works properly with the “reset 
own” option on the B6700 computer. 
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ALGORITHM 527 
A Fortran Implementation of the Generalized 
Marching Algorithm [D3] 


RANDOLPH E. BANK 
The University of Chicago 


Key Words and Phrases: marching algorithms, block tridiagonal, elliptic partial differential equations 
CR Categories: 5.14, 5.17 
Language: Fortran 


1. DESCRIPTION 


Subroutines GMA and GMAS are implementations of the gencralized marching 
algorithm [{1, 2], which may be used to solve linear systems arising from 5-point 
discretizations of separable or constant coefficient elliptic boundary-value problems 
on rectangular domains. A Dirichlet, Neumann, or mixed boundary condition may 
be independently specified on each side of the rectangle; periodic boundary condi- 
tions may be specified on opposing: sides. An appropriate linear system is block 
tridiagonal, or nearly block tridiagonal, real, symmetric, positive or negative 
definite (for GMA) or semidcefinite (for GMAS), and of the form Az = 6: 


T+ al — Bel — Bil L1 b 
— Bol T + ol — B3l L2 be 
ti ¥ ie : or . : = : (1) 
—Byil T+ayi —Byl LN-1 by-1 
— fil —Byl T + ayl tn by 
Here T = TM is the (nearly) tridiagonal MXM matrix 
V1 — 02 — oO; 
—d2 2 — 3 
TM = er i ae (2) 
—Om-1 YmM-1 —% 
—do1 —-Om YM 
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The a;, 6:, y:, and o; are scalars, and x; and b; are M-vectors. Many common dis- 
cretizations which do not automatically yield symmetric matrices A (for example, 
in the case of Neumann or mixed boundary conditions) can be transformed into 
the form of eq. (1) using diagonal similarity transformations [4, 11]. No restrictions 
on N and M, other than N, M > 3 are imposed. 

The eigenvalues of certain principal submatrices of the NX N matrix TN, given 


by 
a —B — Bi 
a Bo 22 — Bs 
TN = £S of, (3) 
—By-1 Qn —- a 
——i —By ay 


are required by the generalized marching algorithm and must be computed in a 
separate preprocessing phase. To solve a problem, the user must call GMA or 
GMAS twice, first to carry out the preprocessing, and then to solve the linear 
system. (If the same linear system is to be solved with many right-hand sides, the 
preprocessing necd be done only once if the contents of the array R are saved.) 
Nineteen other subroutines are called internally as required. 

PARTN, ROOTSC, ROOTSG, SORT, QL, and BANDR are entered during the 
preprocessing phase. In PARTN, the matrix A is partitioned into ND + 1 blocks 
by ND = [N/K] separating lines (the M unknowns in the vector 7; comprise the 
J-th line). Each block has K or fewer lines, where K is the marching parameter 
specified by the user or supplied by default. The integer NE, which satisfies 
QNX® < ND < 2%" —1if ND > 0, NE = Oif ND = 0, is also computed. 

ROOTSC and ROOTSG perform eigenvalue calculations for constant coefficient 
and general separable problems, respectively. SORT orders the eigenvalues ac- 
cording to size, both to insure numerical stability and to allow certain reductions 
in computation to occur in the constant coefficient case. QL and BANDR are called 
by ROOTSC and ROOTSG in conncction with solving the cigenvalue problems; 
they are adaptations of TQLRAT and BANDR from the EISPACK subrou- 
tine library [7, 12]. 

In the backsolution phase, subroutines STEP1, STEP2, STEP3, STEP4, TRI, 
TRI2, MARCH1, MARCH2, and MARCHB are entered. In STEP1 the ND + 1 
problems associated with the partitioned matrix A are partially solved using the 
marching algorithm. Next, in STEP2, NE — 1 ‘2-reductions” are applied to a 
reduced set of equations involving the separating lines. In STEP3, the solution 
vectors x3 corresponding to the separating lines are calculated in NE recursive sub- 
steps, effectively decomposing the N line problem into ND + 1 smaller problems. 
In STEP4, these smaller problems are solved via the marching algorithm. If peri- 
odic boundary conditions are specified for the matrix TN, certain adjustments 
are made in the backsolution process. 

In the backsolution phase, O(N- NE) lincar systems of the form (T — rl)z = y 
are solved; this is done in TRI1 and TRI2. Additionally, the backsolution requires 
O(N) matrix multiplications of the form x = Ty, which are carried out 
in MARCH1, MARCH2, and MARCHS. 

Subroutine GMA is entered using 


CALL GMA(NPC, N, NTYPE, TN1, TN2, M, MTYPE, TM1, TM2, IBDIM, B, K, R, A) 
The parameter list is: 


NPC is an integer. If NPC = 0, GMA does preprocessing calculations; if NPC = 1 
GMaA solves the linear system. 

N is the dimension of the matrix TN; N > 2. 

NTYPE is an integer describing the matrix TN. 
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NTYPE = 1: General separable; Dirichlet, Neumann, or mixed boundary 
conditions. 
A =0;6;40,2<71< N; 
a; arbitrary, 1 <i<N. 
NTYPE = 2: Constant coefficient; Dirichlet, Neumann, or mixed boundary 
conditions. 
&=0;68=6840,3<12N—-1; 
a; = a, aarbitrary,2 <i<N-—1. 
Top boundary condition: One of 


Bo = 8B; a =a (Dirichlet) 
Bo = (VW2)8; a = o (Neumann centered) 
Bo =B;am =-a—B (Neumann noncentered ) 
Bo = 0; a = p, 
p arbitrary (mixed). 
Bottom boundary condition: One of 
By = B; an = @ (Dirichlet ) 
Bu = (V/2)8; on = (Neumann centered) 
By = B; an = a— 8B (Neumann noncentered ) 
By = x # O; an = 0, 
n arbitrary (mixed). 


NTYPE = 3: General separable; periodic boundary conditions. 
a; arbitrary, 1 << i< N. 
NTYPE = 4: Constant coefficient; periodic boundary conditions. 
6 =6 #0, 1<7<N; 
a: = a, aarbitrary, 1 <i < N. 
If N = 3, GMA may respecify NTYPE. 
TN1 is areal array of length N + 1, with TNI(I) = a7,1 <I<N. 
TN2 is a real array of length N + 1, with TN2(1) = 6, 1 <I<N. 
Input values of TN2(N + 1), and TN2(1) if NTYPE < 2, may be overwritten 
by GMA. 
M is the dimension of the matrix TM; M > 2. 
MTYPE is an integer describing the matrix TM. 
MTYPE = 1: General separable; Dirichlet, Neumann, or mixed boundary 
conditions. 
MTYPE = 2: Constant coefficient; Dirichlet, Neumann, or mixed boundary 
conditions. 
MTYPE = 3: General separable; periodic boundary conditions. 
MTYPE = 4: Constant coefficient; periodic boundary conditions. 
Restrictions on ; and o; are analogous to those for a; and f;, respectively, for 
each given type. If M < 5, GMA may respecify MTYPE. 
TM1 is areal array of length M + 1, with TW1(1) = 7, 1<I1I<M. 
TM2 isa real array of length M + 1, with TM2(I) = o,, 1<1<M. 
IBDIM is the row dimension of the array B, as it appears in the calling program. 
B is a two-dimensional array with at least M rows and N columns. On input, B 
contains the right-hand side, with the vector b; residing in the I-th column; 
BJ, I) = (b1)3, 1 < J < M, 1 < I < N. On output B contains the solution, 
with the vector x; residing in the I-th column; B(J, I) = (a1)3, 1 < J <M, 
1<I<N. 
K is the marching parameter. If K < 2, then K assumes the default value K = 2. 
R is a real array of length N-P + 3:N + 2, where log, (N/K) < P, P an integer, 
K > 2. The array R contains the output of a call to GMA with NPC = 0 (pre- 
processing calculations). 
A is a real array of length 4-Q, where Q = max(N + 1,M + 1). This array is used 
as a scratchpad array by GMA. 


Subroutine GMA has one labeled common block, /MACHEP/, containing one 
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variable, TOL. TOL is a machine-dependent constant, which is equal to the ma- 
chine epsilon. It is initialized in GMA in the first executable statement. 

When the matrix A of eq. (1) is positive or negative semidefinite, with zero an 
eigenvalue of multiplicity one, then subroutine GMAS should be used in place of 
GMA to compute a least-squares solution. The usage of GMAS is nearly identical 
to that of GMA, though the two differ internally in several respects. 

First, in the preprocessing phase (NPC = 0), the eigenvector v corresponding 
to the zero eigenvalue is determined by computing appropriate eigenvectors of 
the matrices TN and TM. The particular root 8, for which TM — SI is singular, 
is perturbed to guard against possible divide checks. 

Second, in the backsolution phase (NPC = 1), the right-hand side b is projected 
into the orthogonal complement of the vector v. The right-hand sides for the re- 
duced equations after STEP1 and STEP2 are also projected into their appropriate 
orthogonal complements, since the original orthogonalities may be diminished by 
roundoff growth during these steps of the backsolution. Finally, the solution z is 
projected into the orthogonal complement of v. This completes the least-squares 
solution. 

Subroutine GMAS calls internally the 15 subroutines employed by GMA. Ad- 
ditionally, GMAS calls subroutines TINVIT, PINVIT, SVALUE, and PROJ 
as required. TINVIT and PINVIT are used to compute eigenvectors of symmetric 
tridiagonal matrices and symmetric matrices with periodic boundary conditions, 
respectively, using the method of inverse iteration [11]. TINVIT is a modified 
version of EISPACK subroutine of the same name [7, 12]. Subroutine SVALUE 
computes the perturbation of the root 8. PROJ computes the projections described 
above. 

Subroutine GMAS is entered using 


CALL GMAS(NPC, N, NTYPE, TNi, TN2, M, MTYPE, TM1, TM2, IBDIM, B, VN, VM 
K, BR, A). 


All parameters except VN, VM, and A arc identical to the corresponding parameters 
in the calling sequence for GMA. 


VN is areal array of length N + 1. On output from a call to GMAS with NPC = 0, 
VN contains the eigenvector of TN associated with the zero eigenvalue. 

VM is areal array of length M + 1. On output from a call to GMAS with NPC = 0, 
VM contains the eigenvector of TM associated with the zero eigenvalue. 

A is a real array of length 5-Q, where Q = max(N + 1, M + 1). This array is 
used as a scratchpad array by GMAS. 


2. TESTS 


The operation count for subroutine GMA (GMAS) is O(N-M-NE) = 
O(N-M.-loge (N/K)), with the constant depending on the problem specification 
and the boundary conditions. (If NIX = 0 this becomes O(N-M)). Constant 
coefficient problems are important special cases of gencral separable problems in 
which the operation count can be reduced, often dramatically, by taking advantage 
of the additional restrictions on the coefficients. In Table I we have assembled 
execution times (in milliseconds) for GMA on an IBM 370-195 computer for some 
benchmark values of N = M and K. Both constant coefficient and general separable 
problems were solved to illustrate the savings which can accrue in the special cases. 
The programs were compiled using the Fortran-H compiler, option = 2. Overall 
execution time is given as a sum of preprocessing time (NPC = 0) and backsolu- 
tion time (NPC = 1). 

The constant coefficient problems were all Helmholtz equations in the unit 
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square, with the Helmholtz constant a pseudorandom number between zero and 
one. Dirichlet boundary conditions were imposed on all boundaries. For the general 
separable problems, the 6; and a;, 1 <7< N + 1, were all pseudorandom numbers 
between one and two. Then a; = 6; + Bia1 + p; and y; = of + o41 + 7, 1< 
1 <_N, were calculated, with p; and y; pseudorandom numbers between zero and 
N”’; this insured that the resulting matrices were diagonally dominant, hence 
positive definite. 

The savings which result in the constant coefficient case depend to some extent 


Table I. Execution Times for Subroutine GMA on the IBM 370-195 
(P = preprocessing time (NPC = 0) in milliseconds, B = backsolution time (NPC = 1) in 
milliseconds, T = total execution time in milliseconds. NTYPE = MTYPE = 1 in general 
separable problems, NTYPE = MTYPE = 2 in constant coefficient problems, N = M in all 
problems.) 


Constant coefficient problems | General separable problems 


N= 31 N = 63 N= 127 N= 31 N = 63 N= 127 


3 7 17 22 73 
24 103 449 44 215 
27 110 446 66 288 

3 6 14 22 72 
22 99 444 37 194 
25 105 458 59 263 

2 5 12 19 68 
48 86 4014 27 153 
20 91 413 46 224 

4 4 9 15 59 
14 72 350 17 112 
45 76 359 32 174 

4 2 7 9 48 

8 50 287 9 70 

9 52 294 18 118 


on the boundary conditions, the Dirichlet problem illustrated being the optimal 
case. For both constant coefficient and general separable problems, the execution 
times increase if periodic boundary conditions are imposed. 

In Table II we present some results illustrating the numerical stability of the 
generalized marching algorithm as a function of N = M and K for cach problem 
type. An exact solution x, of pseudorandom numbers on [—1, 1] was generated and 
substituted into the difference equation in order to generate a right-hand side, 
The linear system was then solved, and the computed solution + was compared 
with the exact solution. The number of correct digits was computed using 
digits = —logi ((eTe/xae)"”), @ = te — Xe. REAL#8 arithmetic was used (ap- 
proximately 16 decimal digits). 

For K = 2, 4, the error primarily reflects the condition number of the matrix A. 
When K = 8, 16, 32, however, an exponential “marching” term becomes the 
dominant term in the error [1]. 

Note that both execution time and numerical stability decrease with increasing 
K; thus one must seek to strike a balance between rapid execution times and 
accuracy requirements. 
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Table II. Numerical Stability of Subroutine GMA on the IBM 370-195 


(NTYPE = MTYPE = 1 in general separable problems, NTYPE = MTYPE = 2 in constant 
coefficient problems, N = M in all problems.) 


constant coefficient problems |general separable problems 


N = 127 N= 31 N = 63 N = 127 


£339 13.3 12.5 12.6 
13.9 Lae 12.5 12.6 
11.0 11.4 11.0 11.6 
4.9 4.6 4.1 4.0 
0.0 0.0 0.0 0.0 


Subroutine KPICK is designed to aid the user in making appropriate choices of 
the marching parameter K and to provide other information useful in determining 
if a linear system is appropriate for GMA or GMAS. 

KPICK can be used in two ways: first, to find an optimal value of K for a user- 
specified accuracy demand, or, second, to estimate the accuracy for a user-selected 
value of K. 

KPICK is based on a heuristic which supposes that subroutine GMA (or GMAS) 
yields solutions satisfying error estimates of the form (COND + EMARCH) «TOL, 
where COND is the condition number of the linear system EMARCH is the 
marching error, and TOL is the machine epsilon. In [1], error bounds of this form 
are proved for constant coefficient Dirichlet problems when N = K2"® — 1 for a 
non-negative integer L. 

Subroutine KPICK is entered using 


CALL KPICK (NPC, N, NTYPE, TN1, TN2, M, MTYPE, TM1, TM2, DEMAND, K, COND, 
EMARCH, DIGITS, IFLAG) 


The parameter list is: 


NPC is an integer. YY NPC = 0, KPICK determines K such that the solutions 
computed using subroutine GMA or GMAS will have approximately DEMAND 
significant digits. If NPC = 1, subroutine will test the input value of K. 

N, NTYPE, TN1, TN2, M, MTYPE, TM1, TM2 are identical to the correspond- 
ing parameters in the calling sequence for subroutine GMA. 

DEMAND is the real number, stating the number of significant digits desired in 
the computed solution. It must be specified if NPC = 0. 

KC is an integer. If NPC = 0, on output K is equal to the marching parameter 
determined by KPICK. If NPC = 1, the user must specify the value of K to be 
tested as an input parameter. 

COND is a real number, normally returning the condition number of the linear 
system. 

EMARCH is a real number, normally returning an estimate of the marching error 
for the output value of K. 

DIGITS is a real number, normally returning a value of max(0.0, —log((COND + 
EMARCH)«TOL). This is an estimate of the number of significant digits, in 
the 2-norm, one may expect in the computed solution. 

IFLAG is an integer, describing error returns. 

IFLAG = 0: Normal return. 

IFLAG = 1: KPICK failed to successfully compute COND. The linear system 
is not positive or negative definite. If the linear system is positive or negative 
semidefinite with a zero eigenvalue of multiplicity one, the condition is computed 
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relative to the orthogonal complement of the eigenvector associated with the 

zero eigenvalue. Otherwise the default values COND = EMARCH = DIGITS 
= 0.0 are returned. 

IFLAG = 2: The marching error may not satisfy the assumptions underlying 
the algorithm used to compute EMARCH. (The marching error appears to 
grow more slowly than (2-5)*.) If NPC = 0, KPICK returns estimates for 
K = 2;if NPC = 1, KPICK returns estimates for the input value of K. 

IFLAG = 3: Conditions 1 and 2 exist. 

IFLAG = 4: The linear system cannot be solved to DEMAND significant 
digits for any K > 2. KPICK returns estimates for K = 2. This return can 
occur only if NPC = 0. 

IFLAG = 5: Conditions 1 and 4 exist. 

IFLAG = 6: Conditions 2 and 4 exist. 

= 7: Conditions 1, 2, and 4 exist. 

IFLAG = 8: The input values of N, NTYPE, TN1, and/or TN2 are incorrectly 
specified. 

IFLAG = 9: The input values of M, MTYPE, TM1, and/or TM2 are incor- 
rectly specified. 

IFLAG = 10: Conditions 8 and 9 exist. 


If IFLAG = 0, 2, 4, 6, then the problem is appropriate for subroutine GMA 

~ with the qualifications noted above. If IFLAG = 1, 3, 5, 7, with other than default 

values for COND, EMARCH, and DIGITS, then the problem is appropriate for 
GMAS. 

Subroutine KPICK calls subroutines TCHECK, EIGEN, TRIEIG, PEREIG, 
and ERROR as required. TCHECK is used to determine if the matrices TN and 
TM have been correctly specified. Then COND is determined by computing the 
extremal eigenvalues of TN and TM;; this is done in EIGEN. For some matrix 
types, the eigenvalues are well known; otherwise TRIEIG or PEREIG are used. 
These routines compute eigenvalues of symmetric tridiagonal and periodic matrices, 
respectively, using bisection and the Sturm sequence property [4, 11]. 

For a fixed value of K, EMARCH is defined to be the largest 2-norm over the 
set of marching polynomials arising in STEP1 or STEP4 of the generalized march- 
ing algorithm [1, 2]. For a fixed value of K, subroutine ERROR is used to compute 
the marching error; the three-term recurreuce relation for generating the marching 
polynomials is employed [1, 2]. If NPC = 1 computation of EMARCH is straight- 
forward; if NPC = 0, the method of bisection is used to determine the optimal 
value of K, and hence EMARCH. 

To test the effectiveness of KPICK, 3000 random problems (1000 nonsingular, 
1000 singular, and 1000 where singularity was randomly determined) were solved 
on an IBM 370-195 using REAL#8 arithmetic. All required input values for KPICK, 
GMA, and GMAS were generated using random number generators of the type 
used in testing the EISPACK codes [7]. 

The values of N and M were random integers between 3 and 63; NT YPE and 
MTYPE were random integers between 1 and 4 (for type-2 matrices, the boundary 
condition combination was determined randomly). The matrix entries themselves 
were generated using random real numbers on [10°°, 1.0]. Positive or negative 
definiteness (semidefiniteness) was determined randomly. 

The parameter DEMAND was a random real number on [1.0, —log(TOL) — 
1.0]. Exact solutions were generated using random numbers on [—1.0, 1.0] and 
were substituted into the difference equations to generate right-hand sides. 

The random problems were analyzed by KPICK, with NPC = 0; the values of 
K produced in this fashion ranged between 2 and 29. The problems were then 
solved, using GMA or GMAS, and. the computed solutions compared with the 
exact solutions. The number of correct digits, in the 2-norm, of the computed 
solution ACTUAL was determined and compared with the estimate of DIGITS 
provided by KPICK. The results are summarized in Table ITI, where we have 
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Table III. Effectiveness of Subroutine KPICK in Predicting the Error for 
3000 Random Problems 


(ACTUAL = actual number of correct digits in the computed solution in the 2-norm using 
GMA or GMAS, DIGITS = number of correct digits predicted by KPICK.) 


1000 


900 


Number of 
problems 


800 
700 


600 


500 
400 
300 
200 
100 
20 6 


0 
-2.0-1.5 -1.0 -.5 0 ae dO AaB 260 ~ 25 Bo: BS AsO 


ACTUAL - DIGITS 
mean = .78 


variance = .48 


graphed the value of ACTUAL-DIGITS versus the number of problems. The 
results indicate the effectiveness of KPICK in predicting the accuracy of computed 
solutions using GMA and GMAS. The results for singular and nonsingular problems 
considered separately are essentially the same as those given in Table ITI. 

Other Fortran programs for solving eq. (1) or certain special cases using fast 
direct methods can be found in [8, 8]; theoretical discussions of the algorithms are 
given in [5, 6, 9, 10]. 
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ALGORITHM 
SUBROUTINE GMA(NPC,N,NTYPE,TN1,TN2,M,MTYPE, GMAGOGO1¢ 
1 T™1,1™2,IBDIM,B,K,R,A) GMAGOO20 

Cc SUBROUTINE GMA IS AN IMPLEMENTATION OF THE GENERALIZED GMAGGO36 

Cc MARCHING ALGORITHM, WHICH MAY BE USED FOR SOLVING LINEAR GMAGOO4¢ 

Cc SYSTEMS ARISING FROM 5 POINT DISCRETIZATIONS OF SEPARABLE GMAGOO5¢ 

c OR CONSTANT COEFFICIENT ELLIPTIC BOUNDARY VALUE PROBLEMS GMAGGG60 

ON RECTANGULAR DOMAINS. A DIRICHLET, NEUMANN, OR MIXED GMAOOO7@ 
BOUNDARY CONDITION MAY BE INDEPENDENTLY SPECIFIED ON EACH GMAGOO8G 
SIDE OF THE RECTANGLE, OR PERIODIC BOUNDARY CONDITIONS MAY GMAGOG90 
BE SPECIFIED ON OPPOSING SIDES. GMAGO100 
THE LINEAR SYSTEM HAS THE FORM: GMAGG11¢ 
GMAG0120 

( TM1(I) + TNI(J) ) * X(I,J) GMAGG130 
- TM2(I+1) * X(I+1,J) - M2(I) * X(I-1,J) GMAGG14¢ 

~- TN2(J+1) * X(I,J+1) - TN2(J) * X(I,J-1) = BCI,J) GMAGO15¢ 
GMAOO16¢ 

FOR I = 1,2,...,M, AND J = 1,2,...,N, WHERE TM2(M+1) IS GMAGO17¢ 
INTERPRETED AS TM2(1), TN2(N+1) AS TN2(1), X(@,J3) AS X(M,J), GMAGO18¢ 
X(M+1,J) AS X(1,3), X(I,@) AS X(I,N), AND X(I,N+1) AS X(I,1). GMAQGG19¢ 
GMAOG200 

THE PARAMETER LIST: GMAQG21¢ 
GMA0O226 

NPC IS AN INTEGER. IF NPC = @, GMA DOES NECESSARY GMAGG230 
PREPROCESSING CALCULATIONS. IF NPC = 1, GMA SOLVES THE GMAGG246 
LINEAR SYSTEM. GMAG9256 

N IS AN INTEGER, AS DEFINED ABOVE. N MUST BE GREATER THAN 2. GMAGO26¢ 
NTYPE IS AN INTEGER DESCRIBING THE ARRAYS TN1 AND TN2. GMAQG270 
NTYPE = 1: GENERAL SEPARABLE - DIRICHLET, NEUMANN, OR GMAGO286 
MIXED BOUNDARY CONDITIONS. GMAGO29¢ 
TN1(I) IS ARBITRARY, I = 1,2,...,N. GMAGO306 
TN2(1) = 0.6; TN2(I) IS ARBITRARY, NONZERO, I = 2,3,...,N. GMAGO31¢ 
NTYPE = 2: CONSTANT COEFFICIENT - DIRICHLET, NEUMANN, GMAGG329 

OR MIXED BOUNDARY CONDITIONS. GMAGO330 
TN1(I) = ALPHA, ALPHA AN ARBITRARY CONSTANT, I = 2,3,...N-1.GMAG0346 
TN2(1) = @.@; TN2(I) = BETA, BETA AN ARBITRARY NONZERO GMAGO35¢ 
CONSTANT, I = 3,...,N-l. GMAO036¢ 

TOP BOUNDARY CONDITION : ONE OF GMAGO37@ 
TN1(1) = ALPHA; N2(2) = BETA; (DIRICHLET) GMAGO386 
TN1(1) = ALPHA; TN2(2) = SQRT(2) * BETA; (NEUMANN-CENTERED)GMAQG39@ 
TN1(1) = ALPHA -— BETA; 1TN2(2) = BETA; (NEUMANN-STAGGERED) GMAGO4¢¢ 
TN1(1) = RHO, RHO ARBITRARY; TN2(2) = ZETA, ZETA ARBITRARY, GMAGQ41¢ 
NONZERO; (MIXED). GMAGO42¢ 
BOTTOM BOUNDARY CONDITION : ONE OF GMA9G430 
TN1(N) = ALPHA; TN2(N) = BETA; (DIRICHLET) GMAGG44G 
TNI(N) = ALPHA; TN2(N) = SQRT(2) * BETA; (NEUMANN-CENTERED)GMA@045@ 
TNI(N) = ALPHA - BETA; TN2(N) = BETA; (NEUMANN-STAGGERED) GMA6Q46¢ 
TNI(N) = CHI, CHI ARBITRARY; TN2(N) = ETA, ETA ARBITRARY, GMA@@47¢ 
NONZERO; (MIXED). GMA9G48¢ 
NTYPE = 3: GENERAL SEPARABLE - PERIODIC BOUNDARY CONDITIONS .GMAG049¢ 
TN1(I) IS ARBITRARY, I = 1,2,...,N.’ GMAGO560 
TN2(I) IS ARBITRARY, NONZERO, I = 1,2,...,N. GMAGO51¢ 
NTYPE = 4: CONSTANT COEFFICIENT - PERTODIG BOUNDARY GMAGO52¢ 
CONDITIONS. GMAGO53¢ 
TN1(I) = ALPHA, ALPHA ARBITRARY, I = 1,2,...,N. GMAGO546 
TN2(I) = BETA, BETA ARBITRARY, NONZERO, I = 1,2,...,N. GMAGG556 

IF N = 3, GMA MAY RESPECIFY NTYPE. GMAGO566 

TN1 IS AN ARRARY OF LENGTH N+1, DEFINED ABOVE. GMAG657¢ 
TN2 IS AN ARRAY OF LENGTH N+1, DEFINED ABOVE. GMA0058¢ 
M IS AN INTEGER, AS DEFINED ABOVE. M MUST BE GREATER THAN 2. GMA9G59@ 
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AANA ND ANADAANANANAANAANAAANAANNAANANAANANAANAANAGAAAAAnAN 


aan 


MTYPE IS AN INTEGER DESCRIBING THE ARRAYS TM1 AND TM2. 
MTYPE = 1: GENERAL SEPARABLE — DIRICHLET, NEUMANN, OR 
MIXED BOUNDARY CONDITIONS. 

MIYPE = 2: CONSTANT COEFFICIENT - DIRICHLET, NEUMANN, 
OR MIXED BOUNDARY CONDITIONS. 


GMAGG600 
GMAGG61¢ 
GMAGG6 26 
GMAGG630 
GMAGG640 


MTYPE = 3: GENERAL SEPARABLE - PERIODIC BOUNDARY CONDITIONS .GMAG@65@ 


MTYPE = 4: CONSTANT COEFFICIENT - PERIODIC BOUNDARY 
CONDITIONS. 

RESTRICTIONS ON TM1 AND TM2 ARE ANALOGOUS TO THOSE ON 
TN1 AND TN2, RESPECTIVELY, FOR EACH GIVEN TYPE. 

IF M IS LESS THAN 6, GMA MAY RESPECIFY MTYPE. 

Tl IS AN ARRAY OF LENGTH Mtl, DEFINED ABOVE. 

JM2 IS AN ARRAY OF LENGTH M+l1, DEFINED ABOVE. 

IBDIM IS THE ROW DIMENSION OF THE ARRAY B, AS IT APPEARS 
IN THE CALLING PROGRAM. 

B IS A TWO DIMENSIONAL ARRAY WITH AT LEAST M ROWS AND N 
COLUMNS. ON INPUT, B CONTAINS THE RIGHT HAND SIDE B(I,J) 
AS DEFINED ABOVE. ON OUTPUT, FROM A CALL TO GMA WITH 
NPC = 1, B CONTAINS THE SOLUTION X(I,J), AS DEFINED ABOVE. 

K IS THE MARCHING PARAMETER. MARCHING OCCURS IN THE 
N - DIRECTION. ON INPUT, IF K IS LESS THAN 2, IT 
ASSUMES THE DEFAULT VALUE K = 2. 

R IS AN ARRAY OF LENGTH N * P + 3 * N + 2, WHERE P IS AN 
INTEGER GREATER THAN OR EQUAL TO LOG2( N / K ), AND K IS 
GREATER THAN OR EQUAL TO 2. R CONTAINS THE OUTPUT FROM A 
CALL TO GMA WITH NPC = @. 

A IS AN ARRAY OF LENGTH 4 * Q, WHERE Q = MAX( N+tl, Mtl ). 

A IS USED AS A SCRATCHPAD ARRAY BY GMA. 


SUBROUTINE GMA HAS ONE LABELED COMMON BLOCK, /MACHEP/, 
WITH ONE VARIABLE, TOL. TOL IS A MACHINE DEPENDENT CONSTANT, 
EQUAL TO THE MACHINE EPSILON, IT IS INITIALIZED IN GMA IN THE 
FIRST EXECUTABLE STATEMENT. 


A CALL TO GMA WITH NPC = @ MUST PRECEDE A CALL TO GMA 
WITH NPC = 1. IF THE SAME LINEAR SYSTEM IS TO BE SOLVED 
WITH SEVERAL RIGHT HAND SIDES, A SINGLE CALL TO GMA WITH 
NPC = @ WILL SUFFICE, PROVIDED THAT THE CONTENTS OF THE 
ARRAY R ARE SAVED. 

SUBROUTINE GMA MAY FAIL TO GIVE CORRECT ANSWERS IF 
THE LINEAR SYSTEM IS NOT POSITIVE OR NEGATIVE DEFINITE. 


IF N, NIYPE, M, MIYPE, UK 1LBDLM ARE OUT UF RANGE, GMA RETURNS 
WITHOUT ATTEMPTING ANY COMPUTATIONS. 


ADDRESS INQUIRIES TO: 
RANDOLPH E. BANK 
DEPARTMENT OF MATHEMATICS 
THE UNIVERSITY OF CHICAGO 
CHICAGO ILLINOIS 69637. 


VERSION DATE: MARCH 1, 1977. 
DIMENSION TN1(1),TN2(1),T1(1),TM2(1),A(12),B(1),R(1) 
COMMON /MACHEP/TOL 

TOL=2.@EQ** (-23) 

CHECK N, NIYPE, M, MTYPE, AND IBDIM. 

IF ((NTYPE.GT.4) .OR. (NTYPE.LT.1)) RETURN 

IF ((MTYPE.GT.4) .OR. (MTYPE.LT.1)) RETURN 

IF((N.LT.2).OR, (M.LT.2)) RETURN 

IF(IBDIM.LT.M) RETURN 

RESPECIFY NTYPE AND/OR MTYPE IF NECESSARY. 

IF (NTYPE.EQ.2.AND.N.LE.3) NTYPE=1 

IF (MTYPE.EQ.2.AND.M.LE.3) MTYPE=1 

IF (NTYPE.EQ.4.AND.N.LE.3) NTYPE=3 

IF (MTYPE.EQ.4.AND.M.LE.5) MTYPE=3 

IF(N.LE.2) NTYPE=1 

IF(M.LE.2) MTYPE=1 

IF(NPC.NE.@) GO TO 15 

THE PREPROCESSING CALCULATIONS. 

CALL PARTN(N,NTYPE,K,NE,ND,R(3)) 

EPS IS ADDED TO ALL INTEGERS STORED IN THE REAL ARRAY R. 

THIS PREVENTS UNFORTUNATE ROUNDING ERRORS FORM OCCURRING WHEN 

THEY ARE CONVERTED BACK INTO INTEGERS. 

EPS=@.25E@ 

R(1)=FLOAT (NE)+EPS 

R(2)=FLOAT (ND)+EPS 

IF (NTYPE.EQ.1.OR.NTYPE.EQ.3) CALL ROOTSG(N,NTYPE, 
TN1,TN2,NE,ND,R(3) ,R(N+3) ,A) 

IF (NTYPE.EQ.2.OR.NTYPE.EQ.4) CALL ROOTSC(N,NIYPE, 
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TN1,TN2,NE,ND,R(3) ,R(N+3) ,A) 
J1=N+2 
J2=J14+N+1 


CALL SORT(N,NTYPE,NE,ND,R(3) ,R(N+3) ,A(1) ,ACJ1) ,A(J2)) 


RETURN 

THE BACKSOLUTION CALCULATIONS. 

TN2 (N+1)=1.@E@ 

IF (NTYPE.LT.3) TN2(1)=1.0E@ 

NE=R (1) 

ND=R (2) 

CALL STEP1(N,NTYPE,TN1,TN2,M,MTYPE,1M1 ,1TM2, 
IBDIM,B,ND,R(3),R(N+3) ,A) 

CALL STEP2(N,NIYPE,TN2,M,MTYPE,TM1,TM2, 
IBDIM,B,NE,ND,R(3),R(N+3) ,A) 

CALL STEP3(N,NTYPE,TN2,M,MIYPE,TM1 ,IM2, 
IBDIM,B,NE,ND,R(3) ,R(N+3) ,A) 


CALL STEP4(TN1,TN2,M,MTYPE, TMI ,TM2,IBDIM,B,ND,R(3) ,R(N+3) ,A) 


RETURN 
END 


SUBROUTINE PARTN(N,NTYPE,K,NE,ND,ID) 


SUBROUTINE PARTN PARTITIONS THE GRID, IN THE N - DIRECTION, 
POINTERS TO THE 

THE VALUE 

OF THE INTEGER NE, ROUGHLY EQUAL TO LOG2(ND), IS COMPUTED. 


EPS IS ADDED TO ALL INTEGERS STORED IN THE REAL ARRAY ID. 
THIS PREVENTS UNFORTUNATE ROUNDING ERRORS FORM OCCURRING WHEN 


INTO ND+1 BLOCKS, EACH WITH K OR FEWER LINES. 
SEPARATING LINES ARE STORED IN THE ARRAY ID. 


THEY ARE CONVERTED BACK INTO INTEGERS. 

VERSION DATE: FEBRUARY 1, 1977. 
REAL ID 
DIMENSION ID(1) 

EPS=.25E@ 

NN=N 

IF(NTYPE.GE.3) NN=N-1 

ND=NN/MAX@(K, 2) 

NE=¢ . 

IF(24ND.EQ.NN) ND=ND-1 

IF(ND.EQ.@) GO TO 1¢ 

T1=NN/ (ND+1) 

I2=NN-11* (ND+1) 

13=¢ 

DO 5 J=1,ND 
IF(13.LT.12) 13=13+1 
Jl=J*I1+13 
ID (J+1)=FLOAT (J1)+EPS 
J2=2k* (J-1) 
IF(J2.LE.ND.AND.ND.LE.(2*J2-1)) NE=J 
CONTINUE 

ID(1)=EPS 

Ll=ND+2 

DO 15 J=I1,N 
ID (J)=FLOAT (NN+1)+EPS 

RETURN 

END 


SUBROUTINE ROOTSC(N,NTYPE,TN1,TN2,NE,ND,ID,R,A) 
SUBROUTINE ROOTSC DOES THE NECESSARY EIGENVALUE 
CALCULATIONS FOR CONSTANT COEFFICIENT PROBLEMS. 
THE EIGENVALUES ARE STORED IN THE ARRAY R. 
VERSION DATE: FEBRUARY 1, 1977. 
REAL ID 
DIMENSION TN1(1),TN2(1),ID(1),R(1),A(1) 
NP1=N+1 
NEP1=NE+1 
NDP1=ND+1 
PI=3 .1415926535897932384626433832795E0 
T1=TN1 (2) 
T2=TN2 (3) 
T22=2.GEQ*T2 
S=ABS (T22) 


IN THE FOLLOWING SEGMENT OF CODE, SPECIAL EIGENVALUES FOR THE 


CASE NTYPE = 4 ARE COMPUTED. 
IF(NTYPE.EQ.2) GO TO 139 
LINE=N*NEP 1 

I2=LINE+N 
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R(12)=T1-S 

R(LINE+1)=T1+S 

NMl=N-1 

I2=2 

Q=P1/FLOAT(N) 

IF (T22.LT.@.GE@) GO TO 11¢ 

LINE=LINE+N 

I2=—2 

DO 115 I=2,NM1,2 
LINE=LINE+I2 
ARG=Q* FLOAT (1) 
R(LINE)=T1-T22*COS (ARG) 

+1) =R (LINE 
IN SET Tne’ SrCLENT OF CODE, EIGENVALUES RELEVANT TO ALL 


CONSTANT COEFFICIENT PROBLEMS ARE CALCULATED. 

DO 149 I=1,NEP1 
12=2k* (I-1) 

J2=N* (I-1) 

DO 14¢ LNINDX=1,NDP1,12 
LINE=ID (LNINDX) 
ISPAN=LNINDX+12 
ISPAN=ID (ISPAN) 
ISPAN=ISPAN-LINE-1 
LINE=LINE+J2 
Q=PI/FLOAT (ISPAN+1) 

DO 135 J=1,ISPAN 
LINE=LINE+1 
ARG=Q*FLOAT (J) 
R(LINE)=T1+S*COS (ARG) 

R(LINE+1)=¢. GE 

CONTINUE 

IF(NTYPE.EQ.4) RETURN 


IN THE FOLLOWING SEGMENT OF CODE, WE CHECK FOR NEUMANN OR MIXED 


BOUNDARY CONDITIONS, AND MODIFY SOME EIGENVALUES IN THE 
APPROPRIATE FASHION. 
ICOUNT KEEPS TRACK OF THE ROUNDARY CONDITION COMBINATION. 
ICOUNT=¢ 
IAl=1 
IA2=¢@ 
S2=SQRT (2.QEQ@)*T2 
DO 27¢ L=1,2 
I2=2*TAL+N*IA2 
T2P=TN2 (12) 
I2=I2-IAl 
TIP=TN1 (12) 
IF(T2P .EQ.T2.AND.TIP.EQ.T1) GO TO 265 
NN=ID (ND+2) 
NN=NN*IA2 
IF(TIP.EQ.T1.AND.T2P.EQ.S2) GO TO 22¢ 
IF (T2P .EQ.T2.AND.TIP.EQ.(T1-T2)) GO TO 225 
LOOP FOR A MIXED BOUNDARY CONDITION 
ICOUNT=ICOUNT+7 
IF(NE.EQ.0) GO TO 265 
DO 215 I=1,NE 
I2=2%* (I-1) 
LINE=(ND/12)*IA2*12 
LINE=ID (LINE+1) 
ISPAN=ID (12+1) 
ISPAN=ISPAN*IA1+NN-LINE-1 
LINE=LINE+N* (1-1) 
J2=N 
DO 245 J=1,ISPAN 
J2=J2+1 
A(J)=T1 
A(J2)=-T2 
A(J2)=@.QEO 
A(1)=TI1P 
A(NP1)=-T2P 
CALL QL(A(1),A(NP1), ISPAN, IERR) 
J2=ISPAN+1 
DO 216 J=1,ISPAN 
J2=J2-1 
LINE=LINE+1 
R(LINE) =A (J2) 
CONTINUE 


GO TO 265 
THE LOOP FOR A NEUMANN BOUNDARY CONDITION 


ICOUNT=ICOUNT+1 


THE 
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INS=@ 
GO TO 23¢ 
ICOUNT#ICOUNT+3 
INS=1 
IF(NE.EQ.@) GO TO 265 
Ji=¢ 
J2=2 
IF(T22.LT.@.@E@) GO TO 24¢ 
Jl=2 
J2=-2 
DO 25¢ I=1,NE 
I2=2%* (I-1) 
LINE=(ND/1I2)*IA2*12 
LINE=ID (LINE+1) 
ISPAN#ID (12+1) 
ISPAN=LSPAN*IA1+NN-LINE-1 
LINE=LINE+N* (I-1) 
Q=PI/FLOAT (2* ISPAN+INS) 
J#J1* (ISPAN+1)-1 
DO 245 JJ=1,ISPAN 
J=J+J52 
LINE=LINE+1 
ARG=Q* FLOAT (J) 
R (LINE) =T1-T22*COs (ARG) 
CONTINUE 
IA1L=¢ 
TA2=1 
IF (ICOUNT.EQ.@) RETURN 
LINE=N*NE 
IF(ICOUNT.GE.7) GO TO 4¢6¢ 
GO TO (425, 436,435,446, 460,445) , ICOUNT 
IN THE FOLLOWING SEGMENT, EIGENVALUES FOR THE CASE OF ONE 
OR MORE MIXED BOUNDARY CONDITIONS ARE CALCULATED. 
J2=N 
DO 465 J=1,N 
J2=J2+1 
A(J)=T1 
A(J2)==-T2 
A(1)=TN1 (1) 
A(N)#TN1 (N) 
A(NP1)=-TN2 (2) 
A(J2-1)=-TN2 (N) 
A(J2)=¢ .GE@ 
CALL QL(A(1) ,A(NP1) ,N, TERR) 
J2=NP1 
DO 41¢ J=1,N 
LINE=LINE+1 
J2=J2=-1 
R(LINE)=A(J2) 
RETURN 
IN THE FOLLOWING SEGMENT, EIGENVALUES FOR THE CASE OF ONE 
NEUMANN AND ONE DIRICHLET BOUNDARY CONDITION ARE CALCULATED. 
Q=P1I/FLOAT (2*N) 
T22=-S 
J=-1 


2 to 456 

IN THE FOLLOWING SEGMENT, EIGENVALUES FOR THE CASE OF TWO 
NEUMANN BOUNDARY CONDITIONS ARE CALCULATED. 
Q=PI/FLOAT(N—1) 

T22=-S 

J=-1 

J2=1 

GO TO 450 

IN THE FOLLOWING SEGMENT, EIGENVALUES FOR THE CASE OF ONE 


STAGGERED AND ONE DIRICHLET BOUNDARY CONDITION ARE CALCULATED. 


Q=PI/FLOAT (2*N+1) 
=-] 
J2=2 
IF(T22.LT.@.GE@) GO TO 45¢ 
J=24*N+1 
J2==2 
GO TO 45¢ 
IN THE FOLLOWING SEGMENT, EIGENVALUES FOR THE CASE OF ONE 
NEUMANN AND ONE STAGGERED BOUNDARY CONDITION ARE CALCULATED. 
Q=PI/FLOAT (2*N-1) 
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J=-2 
J2=2 
IF(T22.LT.0.GE@) GO TO 45¢ 
J=24N 
J2=-2 
GO TO 45¢ 
IN THE FOLLOWING SEGMENT, EIGENVALUES FOR THE CASE OF TWO 
STAGGERED BOUNDARY CONDITIONS ARE CALCULATED. 
Q=PI/FLOAT (N) 
J=-1 
J2=1 
IF(T22.LT.0.@E@) GO TO 45¢ 
J=N 
J2=-1 
DO 455 JJ=1,N 
J=J+J2 
LINE=LINE+1 
ARG=Q* FLOAT (J) 
R(LINE) =T1-T22*COS (ARG) 
RETURN 
END 


SUBROUTINE ROOTSG(N,NTYPE,TN1,TN2,NE,ND,ID,R,A) 
SUBROUTINE ROOTSG DOES THE NECESSARY EIGENVALUE 
CALCULATIONS FOR GENERAL SEPARABLE PROBLEMS. 
THE EIGENVALUES ARE STORED ON THE ARRAY R. 
VERSION DATE: FEBRUARY 1, 1977. 
REAL ID 
DIMENSION TN1(1),TN2(1),ID(1),R(1),AC1) 
NP1=N+1 
NEP1=NE+1 
NDP1=ND+1 
IN THE FOLLOWING SEGMENT OF CODE, SPECIAL EIGENVALUES FOR THE 
CASE NTYPE = 3 ARE COMPUTED. 
IF (NTYPE.EQ.1) GO TO 5@ 
N2=(NP1)/2 
NP2=NP1+NP1 
NP3=NP1+NP2 
DO 35 I=1,N2 
Il=2*1 
I2=NP1-1 
TL=NP3+1I 
A(11-1)=TN1 (1) 
A(I1)=TN1 (12) 
L1=NP2+I1 
A(I1-1)=@.@E@ 
A(11)=@.@E@ 
L1=NP1+II 
A(I1-1)=-TN2 (1) 
A(1I1)=-TN2(12+1) 
A(NP2+2)=-TN2 (1) 
A(NP3-1)=-TN2 (N2+1) 
A(NP14+1)=@.GE@ 
A(NP1+2)=@.GE@ 
CALL BANDR(A(1) ,A(NP1+1) ,A(NP24+1) ,A(NP3+1) ,N) 
CALL QL(A(1),A(NP1+1) ,N, TERR) 
LINE=N*NEP 1 
J2=NP1 
DO 4@ I=1,N 
LINE=LINE+1 
J2=J2-1 
R(LINE)=A(J2) 
IN THE FOLLOWING SEGMENT OF CODE, EIGENVALUES RELEVANT TO ALL 
GENERAL SEPARABLE PROBLEMS ARE CALCULATED. 
DO 65 I=1,NEP1 
12=2** (I-1) 
J2=N* (1-1) 
DO 65 LNINDX=1,NDP1,12 
LINE=ID (LNINDX) 
ISPAN=LNINDX+12 
ISPAN=ID (ISPAN) 
ISPAN=ISPAN-LINE-1 
J1=N 
L1=LINE 
DO 55 J=1,ISPAN 
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Jl=J1+1 
Il=I1+1 
A(J)=TN1 (11) 
A(J1)=-IN2(I1+1) 
A(J1)=@.GE@ 
CALL QL(A(1) ,A(NP1) , ISPAN, TERR) 
LINE=LINE+J2 
J1=ISPAN+1 
DO 6¢ J=1,ISPAN 
LINE=LINE+1 
Jl=J1-1 
R(LINE)=A(J1) 
R(LINE+1)=0.QEO 
CONTINUE 
RETURN 
END 


SUBROUTINE SORT(N,NTYPE,NE,ND,ID,R,A,IPI,KPI) 
SUBROUTINE SORT ORDERS THE EIGENVALUES COMPUTED IN ROOTSC 
OR ROOTSG ACCORDING TO SIZE. THIS MUST BE DONE TO INSURE THE 
NUMERICAL STABILITY OF THE ALGORITHM. IN THE CASE OF CONSTANT 
COEFFICIENT PROBLEMS, SORTING THE EIGENVALUES ALLOWS SOME 
REDUCTION IN COMPUTIONS TO TAKE PLACE. 
THE ARRAY IPI KEEPS TRACK OF THE PERMUTATIONS. 
VERSION DATE: FEBRUARY 1, 1977. 
REAL ID,IPI,KPI 
DIMENSION IPI(1),KPI(1),A(1),R(1),ID(1) 
IF (NE.EQ.@) RETURN 
NP1=N+1 
NN=NP1 
IF(NTYPE.GE.3) NN=N 
LINET=N*NE+1 
LINEB=LINET+NN-2 
RMIN=AMIN1 (R(LINET) ,R(LINEB) )-2.GE@ 
EPS IS ADDED TO ALL INTEGERS STORED IN THE REAL ARRAY IPI. 
THIS PREVENTS UNFORTUNATE ROUNDING ERRORS FORM OCCURRING WHEN 
THEY ARE CONVERTED BACK INTO INTEGERS. 
EPS=@. 25E@ 
DO 5¢5 I=1,N 
A(T)=R(I1) 
IPI (1)=FLOAT (1)+EPS 
KPI (1I)=IPI(1) 
DO 53¢ I=1,NE 
I2=2k4*T 
Il=1I2/2 
DO 51¢ LNINDX=I1,ND,I1 
LINE=ID (LNINDX+1) 
A(LINE)=RMIN 
A(NN)=RMIN 
DO 526 LNINDX=I1,ND,12 
LINET=LNINDX-I1+1 
LINET=ID (LINET) 
LINET=LINET+1 
LINEB=ID (LNINDX+1) 
LINEB=LINEB+1 
LINE=LINET+1 
ISPAN=LNINDX+11+1 
ISPAN=ID (ISPAN) 
ISPAN=ISPAN-1 
KPI (LINET)=IPI(LINEB~1) 
DO 52@ J=LINE, ISPAN 
IF (A(LINET) .GT.A(LINEB)) GO TO 515 
KPI (J)=IPI(LINEB) 
LINEB=LINEB+1 
GO TO 52¢ 
KPI. (J)=IPI (LINET) 
LINET=LINET+1 
CONTINUE 
LINE=N*I 
JPI=LINE 
DO 525 J=1,N 
IPI (J)=KPI(J) 
JPI=JPI+1 
A(J)=R(JPI) 


RTSGO54@ 
RTSGO55@ 
RTSGO56@ 
RTSGO57@ 
RTSGO58@ 
RTSGO59@ 
RTSGG6OG 
RTSGG61¢ 
RTSGO620 
RTSGO63@ 
RTSGG64@ 
RTSGG65@ 
RTSGO66¢G 
RTSGG670 
RTSGO68G 
RTSGG69@ 
RTSGO70O 


SORTOO1O 
SORTOG20 
SORTOG36 
SORTOO40 
SORTOG56 
SORTOGEO 
SORTOO7@ 
SORTOO8O 
SORTOGIO 
SORTO16@ 
SORTO11¢ 
SORTG120 
SORT@130 


SORTG14¢ 
SORTO15¢@ 


SORTO160 
SORTO17O6 
SORTO180 
SORTO19@ 
SORTO266 
SORTO210 
SORTO22¢ 
SORTO230 
SORTG246 
SORT@250 
SORTO260 
SORT@270 
SORTO286 
SORTO290 
SORTO306¢ 
SORTO31¢ 
SORTO320 
SORTO330 
SORTG34G 
SORTO350@ 
SORTO36@ 
SORTO370 
SORTO380 
SORTO39@ 
SORTO400 
SORTO41¢ 
SORTO42¢ 
SORTO430 
SORTO446 
SORTO45¢ 
SORTO460 
SORTO476 
SORTO48G 
SORTO49O 
SORTG500 
SORTO516 
SORTO526 
SORTO53@ 
SORTO540 
SORTO55@ 
SORTG560 
SORTO57@ 
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DO 53 J=1,N 
JPI=IPI(J) 
JPI=JPI+LINE 
R(JPIL)=A(J) 
THE FOLLOWING SEGMENT OF CODE SORTS THE SPECIAL EIGENVALUES 
WHICH ARISE IN THE CASE OF PERIODIC BOUNDARY CONDITIONS. 
IF(NTYPE.LT.3) RETURN 
LINE=N* (NE+1) 
JPI=LINE 
DO 54¢ J=1,N 
JPI=JPI+1 
A(J)=R(JPL) 
DO 545 J=1,N 
JPI=IPI (J) 
JPI=JPI+LINE 
R(JPI)=A(J) 
RETURN 
END 


SUBROUTINE QL(D,E,N, IERR) 

SUBROUTINE QL FINDS ALL THE EIGENVALUES OF A SYMMETRIC 
TRIDIAGONAL MATRIX, THE RATIONAL (SQUARE ROOT FREE) QL 
ALGORITHM IS USED. QL IS CALLED IN CONNECTION WITH FINDING 
EIGENVALUES FOR GENERAL SEPARABLE PROBLEMS, AND CONSTANT 
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SORTO58@ 
SORTO59@ 
SORTOEOO 
SORTG610 
SORTG620 
SORTO630 
SORTO64G 
SORTQ65@ 
SORTO66G 
SORTQG67@ 
SORTO68G 
SORTO69@ 
SORTO70O 
SORTO71@ 
SORTO72¢ 
SORTO730 
SORTO740 
SORTO750@ 


QLOGED1O 
QLOGGO2O 
QLOGGO30 
QLOGGG4O 
QLODOGSO 


COEFFICIENT PROBLEMS WHERE ONE OR MORE MIXED BOUNDARY CONDITIONSQLOGOG6¢ 


ARE PRESENT. SUBROUTINE QL IS AN ADAPTATION OF SUBROUTINE 
TQLRAT FROM THE EISPACK SUBROUTINE LIBRARY. 


THE DIAGONAL OF THE TRIDIAGONAL MATRIX IS S'TORED IN THE ARRAY 


D, THE CODIAGONAL IN E. THE EIGENVALUES ARE WRITTEN IN D. 
VERSION DATE: MARCH 1, 1977. 
COMMON /MACHEP/TOL 
DIMENSION D(1),E(1) 
IERR=¢ 
IF (N.EQ.1) RETURN 
NM1=N-1 
DO 16@ I=1,NM1 
E(I) =E(1I)* E(I) 
F=0. GEO 
B=. GEQ 
C=. GEO 
E(N)=¢@. GEO 
DO 29% L=l, N 
J=@ 
H=TOL* (ABS (D (L) )+SQRT (E(L) )) 
IF(B.GT.H) GO TO 145 
B=H 
C=B*B 
DO 110 M=L, N 
IF(E(M).LE.C) GO TO 12¢ 
CONTINUE 
M=N 
IF(M.EQ.L) GO TO 21¢ 
IF(J.EQ.36) GO TO 1060 
J=J+1 
Ll=L+1 
S=SQRT(E(L)) 
G=D (L) 
P=(D(L1)-G) /(2.GE@*S) 
R=SQRT (P*P+1 .GEO) 
D(L)=S/(P+SIGN(R,P)) 
H=G-D(L) 
DO 14@ I=L1, N 
D(I)#D(I)-H 
F=F+H 
G=D (M) 
IF(G.EQ.0.Q@EQ@) G=B 
H=G 
S=9.GE@ 
MML=M-L 
DO 2¢@ IIl=1, MML 
I=M-I1 
P=G*H 
R=P+E (I) 
E(I+1)=S*R 
S=E(1)/R 


QLOGGO76 
QLOGOG8O 
QLOGOG90 
QLOGG100 
QLOGG110 
QLOG0120 
QLOG0130 
QLGOG14¢ 
QLOGG15¢ 
QLOGG160 
QLOG0176 
QLOGG18¢ 
QLOGG19¢ 
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QLOG6216 
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QLOGG240 
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QLOG6260 
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QLOGG36¢ 
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QLOGO400 
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QLOG0420 
QLOGO4 30 
QLOGG440 
QLOAG450 
QLOGO46¢ 
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D(I+1) =H+S* (H+D (I) ) 
G=D (I)-E(1I)/G 
IF(G.EQ.¢.GE6) G=B 
H=G*P/R 
CONTINUE 
E(L)=S*G 
D(L)=H 
IF (H.EQ.@.@E@) GO TO 21¢ 
TF (ABS (E(L)) .LE.ABS(C/H)) GO TO 21¢ 
E(L)=H*E (L) 
IF (E(L) .NE.@.@E@) GO TO 13¢ 
P=D (L)+F 
IF(L.EQ.1) GO TO 25¢ 
DO 23@ II=2, L 
IeL+2-I1 
IF(P.GE.D(I-1)) GO TO 27¢ 
D(I)=D(I-1) 
CONTINUE 
I=1 
D(I)=P 
CONTINUE 
GO TO 1601 
IERR®L 
RETURN 
END 


SUBROUTINE BANDR(D,E,W,V,N) 

SUBROUTINE BANDR IS USED TO REDUCE A SYMMETRIC PENTA- 
DIAGONAL MATRIX TO A SYMMETRIC TRIDIAGONAL MATRIX. BANDR IS 
ENTERED ONLY IN THE CASE NTYPE = 3, AND IS CALLED IN 
CONNECTION WITH FINDING THE SPECIAL EIGENVALUES ASSOCIATED 
WITH THE PERIODIC BOUNDARY CONDITIONS. BANDR IS AN ADAPTATION 
OF SUBROUTINE BANDR FROM THE EISPACK SUBROUTINE LIBRARY. 
THE DIAGONAL OF THE PENTADIAGONAL MATRIX IS STORED IN V, 
THE FIRST CO-DIAGONAL IN W, AND THE SECOND CO-DIAGONAL IN E. 
THE DIAGONAL OF THE TRIDIAGONAL MATRIX IS WRITTEN IN D, AND 
THE CO-DIAGONAL IS WRITTEN -IN E, 

VERSION DATE: FEBRUARY 1, 1977. 

DIMENSION D(1),E(1),V(1),W(1) 
DO 3¢ Jel, N 

D(J)=1.GE¢ 
NM2=N-—2 
DO 709 K=1, NM2 

KP2=K+2 

G=E (KP2) 

E (K+1)=W(K+1) 

DO 5¢@ J=KP2, N, 2 

JM1=J—1 

JP1l=J+1 

JP2=J+2 

IF (G.EQ.6.GE6) GO TO 7¢¢ 
B1=E(JM1)/G 
B2=B1*D(JM1)/D(J) 
$2=1.QEG/(1.@EG+B1*B2) 

IF (S2.GE.@.5E@ ) GO TO 45¢ 
Bl=G/E(JM1) 
B2=B1*D(J)/D(JM1) 
C2=1.GEG-S2 

D(JM1)=C2*D (JM1) 
D(J)=C2*D (J) 

Fl=2.Q@E@*W(J) 

F2=B1*V (JM1) 

W(J)=-B2* (BL*¥W(J)-V(J))-F2+W(J) 
V (JML)=B2* (B2*V (J)+F1)+V (JM1) 
V(J)=B1* (F2-F1)+V (J) 

U=W (JM1)+B2*E (J) 
E(J)=-B1*W(JM1)+E(J) 
W(JML)=U 

E(JM1)=E(JM1)+B2*G 

IF (J.EQ.N) GO TO 500 

U=E (JP1)+B2*W(JP1) 
W(JP1)=-B1*E(JP1)+W(JP1) 
E(JP1)=U 

IF (JP2.GT.N) GO TO 5¢@¢ 
G=B2*E(JP2) 


QLOGO570 
QLOGO58¢ 
QLOGO590 
QLOGG6OO 
QLOOG619 
ee 
LOG063 

GL OOELD 
QLOGGESO 
QLOGG660 
QLOG0670 
QLOOG680 
QLOGGE9G 
QLOGO70O0 
QLO906710 
QLOGO7 2 
QLOGO73¢ 
QLOGO740 
QLO60675¢ 
QLOG076¢ 
QLOGO776 
QLOG078¢ 
QLOOG790 
QLOGG8O0 
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BNDROOG16 
BNDRGO20 
BNDROO30 
BNDROO4G 
BNDROO5O 
BNDROG6O 
BNDROO79 
BNDRGO8O 
BNDROOID 
BNDRO1¢6¢ 
BNDRO110 
BNDRG1206 
BNDRO130 
BNDRO14@ 
BNDRO1L5@ 
BNDRO160 
BNDRO17¢ 
BNDRO18@ 
BNDRG19¢ 
BNDRO26¢ 
BNDRO21¢6 
BNDRO22@ 
BNDRO230 
BNDRO24¢ 
BNDRO25¢ 
BNDRO26@ 
BNDRO270 
BNDRO280 
BNDRO29@ 
BNDRO300 
BNDRO3106 
BNDRO32@ 
BNDRO330 
BNDRO34@ 
BNDRO35¢@ 
BNDRO36¢ 
BNDR@370 
BNDRO38¢@ 
BNDRO390 
BNDRO4G¢ 
BNDRO41¢ 
BNDRO42¢ 
BNDRO43¢6 
BNDRG44¢ 
BNDRO4506 
BNDRO46¢ 
BNDRO47@ 
BNDRO48@ 
BNDRO49@ 
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GO TO 5¢¢ 
U=D (JM1) 


D(JM1)=S2*D (J) 


D(J)=S24U 


Fl=2.Q@EQ@*W(J) 
F2=B1*V(J) 
U=B1* (F2-F1)+V (JM1) 


W(J)=B2* (B1*W(J)-V (JM1) )+F2-W(J) 


V(JM1)=B2* (B2*V (JM1)+F1)+V (J) 


V(J)=U 


U=B2*W(JML)+E (J) 
E(J)=-W(JM1)+B1*E (J) 


W(JM1)=U 


E(JM1)=B2*E (JM1)+G 

IF (J.EQ.N) GO TO 500 
U=B2*E (JP1)+W(JP1) 
W(JP1)=-E(JP1)+B1*W(JP1) 


E(JP1)=U 


IF (JP2.GT.N) GO TO 5460 


G=E (JP2) 


E(JP2)=B1*E (JP2) 


CONTINUE 


CONTINUE 


U=1 .GE@ 


DO 85% J=2, N 


E(J)=SQRT (D(J)) 
D(J)=D(J)*V (J) 
E (J-1)=U*E(J)*W(J) 


U=E (J) 
D(1)=V(1) 
E(N)=@.GE@ 


RETURN 
END 


SUBROUTINE STEP1(N,NTYPE,TN1,1TN2,M,MTYPE,TM1 ,TM2, 


IBDIM,B,ND,ID,R,A) 
SUBROUTINE STEP1 CARRIES OUT THE INITIAI, MARCHING PHASE OF 
THE GENERALIZED MARCHING ALGORITHM. 


THE SYSTEM OF EQUATIONS 


IS REDUCED TO AN EQUIVALENT SET FOR THE UNKNOWNS ON THE ND 
SEPARATING LINES. 


VERSION DATE: MARCH 1, 1977. 


REAL ID 


DIMENSION TN1(1),TN2(1),TM1(1),1M2(1),A(1),B(1),R(1), ID(1) 


NN=ND 


IF (NTYPE.GE.3) NN=ND+1 
IF(NN.LT.1) RETURN 


Ml=M+1 
M2=M1+M 


ITYPE=NTYPE-(NTYPE/2)*2 


ID2=ID (2) 


DO 13@ LNINDX=1,NN 
LINE=ID (LNINDX+1) 
LINEA=ID (LNINDX+2) 
LINEB=ID (LNINDX) 


LINEC#LINE 


IF(LINE.EQ.N) LINEC=@ 
ISPANA=LINEA-LINE~1 

IF (ISPANA.LE.@) ISPANA=ID2~1 
ISPANB=LINE-LINEB~1 


CHECK FOR POSSIBLE REDUCTION IN COMPUTATION IN THE 


CONSTANT COEFFICIENT CASE. 


IF ((ITYPE.EQ.1).0OR. (ISPANA.NE.ISPANB)) GO TO 145 
IF ((TN1 (LINEB+1) .EQ.TN1 (LINEA-1)) .AND. 

(TN2 (LINEB+2) .EQ.TN2(LINEA-1))) GO TO 12¢ 
THE FOLLOWING CODE IS EXECUTED WHEN NO REDUCTION 


IN COMPUTATION IS POSSIBLE. 


CALL MARCH] (M,MTYPE,TM1 ,TM2,TN1,TN2,IBDIM,B, 


ISPANB,LINE,-1,A(1),A(M1)) 
INDXRT=LINEB+1 


CALL TRI1(M,MTYPE,TM1 ,TM2,ISPANB,R(INDXRT) , TN2(INDXRT) , 


A(1) ,A(ML) ,A(M2)) 


Tl=TN2 (LINE) 


LNPTR= (LINE-1)*IBDIM 
DO 116 ICOMP=1,M 
LNPTR=LNPTR+1 


BNDRO50@ 
BNDRG51¢ 
BNDRO5 20 
BNDRO53@ 
BNDRO540 
BNDRO55@ 
BNDRQ56@ 
BNDRO57@ 
BNDRO58@ 
BNDRO590 
BNDRO6O0 
BNDRG610 
BNDRG626 
BNDRQ63@ 
BNDRO640 
BNDRO650 
BNDRG660 
BNDRO670 
BNDRO68¢ 
BNDRO69¢ 
BNDRO76@ 
BNDRO71@ 
BNDRO72@ 
BNDRO7 30 
BNDRO74@ 
BNDRQ75@ 
BNDRO76@ 
BNDRO77@ 
BNDRO780@ 
BNDRO79@ 
BNDRO8O¢G 
BNDRO81¢ 
BNDRO8 20 


STP146010 
STP1902¢ 
STP1003¢ 
STP10046 
STP1005¢ 
STP1006¢ 
STP160670 
STP 16480 
STP19069¢ 
STP1916¢ 
STP1911¢ 
STP1912¢ 
STP19¢13¢ 
STP1914¢ 
STP1915¢ 
STP1916¢ 
STP1917¢ 
STP1¢18¢ 
STP1919¢ 
STP192066 
STP1621¢ 
STP1622¢ 
STP1923¢ 
STP1924¢ 
STP1925¢ 
STP10260 
STP1927¢ 
STP1628¢ 
STP1929@ 
STP10300 
STP1931¢ 
STP19320 
STP1633¢ 
STP1934¢ 
STP1435¢@ 
STP1936¢ 
STP1637@ 
STP19380 
STP1939¢ 
STP10400 
STP10410 
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B(LNPTR)=B (LNPTR) -T1*A (ICOMP) 

CALL MARCH] (M,MTYPE,TM1,TM2,TN1,TN2,IBDIM,B, 
ISPANA,LINEC,1,A(1),A(M1)) 

INDXRT=LINEC+1 

CALL TRI1(M,MIYPE,TM1,TM2,ISPANA,R(INDXRT) , TN2(INDXRT) , 
ACL) ,A (M1) ,A(M2)) 

INDXRT=INDXRT+LSPANA 

T1=TN2 (INDXRT) 

LNPTR= (LINE~1)*IBDIM 

DO 115 ICOMP=1,M 
LNPTR=LNPTR+1 
B(LNPTR)=B (LNPTR)-T1*A (ICOMP) 

GO TO 13¢ 

THE FOLLOWING CODE IS EXECUTED FOR CONSTANT “OEFFICIENT 


PROBLEMS IN WHICH A REDUCTION IN COMPUTATION IS POSSIBLE. 


CALL MARCH3(M,MTYPE,TM1,1M2,TN1,TN2,IBDIM,B, 
ISPANB,LINE.LINEC,A(1) ,A(M1)) 
INDXRT=LINEB+1 
CALL TRI1(M,MTYPE,TM1,TM2,ISPANB,R(INDXRT) , 1N2(INDXRT) , 
A(1) ,A(M1) ,A(M2)) 
T1=TN2 (LINE) 
LNPTR= (LINE-1)*IBDIM 
DO 125 ICOMP=1,M 
LNPTR=LNPTR+1 
B(LNPTR)=B (LNPTR) -T1*A (ICOMP) 
CONTINUE 
RETURN 
END 


SUBROUTINE STEP2(N,NTYPE,TN2,M,MTYPE,TM1,1M2, 
IBDIM,B,NE,ND,ID,R,A) 
SUBROUTINE STEP2 USES NE-1 2-REDUCTION STEPS TO REDUCE 
THE SET OF EQUATIONS FOR THE ND SEPARATING LINES TO A MATRIX 
EQUATION FOR A SINGLE LINE OF UNKNOWNS, APPROXIMATELY 
HALF OF THE REMAINING LINES ARE ELIMINATED AT EACH RECURSIVE 
STEP. 
VERSION DATE: MARCH 1, 1977. 
REAL ID 
DIMENSION TN2(1),TM1(1),TM2(1),A(1),B(1),R(1),ID(1) 
NN=NE-1 
IF(NTYPE.GE.3) NN=NE 
IF(NN.LT.1) RETURN 
lom+1 
M2=M14M 
M3=M2+M 
ITYPE=NTYPE-(NTYPE/2)*2 
DO 24¢ I=1,NN 
L2=2*4*I 
Il=12/2 
Jl=(I-1)*N+1 
J2=I14*N+1 
DO 24¢ LNINDX=I1,ND,12 
LINE=ID (LNINDX+1) 
LINEA=LNINDX+1+11 
LINEA=D (LINEA) 
LINEB=LNINDX+1-I1 
LINEB=ID (LINEB) 
ISPANA*LINEA-LINE 
ISPANB=LINE-LINEB 
IF ((LINEB.EQ.@) .AND.(NTYPE.LT.3)) GO TO 215 
LNPTR= (LINE-1)*IBDIM 
DO 2¢5 ICOMP=1,M 
LNPTR=LNPTR+1 
A(CICOMP)=B (LNPTR) 
INDXRT=LINEB+J2 
INDXTN=LINEB+1 
CALL TRI1(M,MTYPE,TM1 ,TM2,ISPANB,R(INDXRT) , TN2(INDXTIN), 
A(1) ,A(M1) ,A(M2)) 
IRTDIF=LINE+J 1 
INDXRT=INDXRT+ISPANB 
ISPAN=1SPANA-1 
CALL TRI2(M,MTYPE,TM1 ,TM2,ISPAN,R(INDXRT) ,R(IRIDIF), 
A(1) ,A(M1) ,A (M2) ,A (M3) ) 
ISPAN=LINEB 
IF(LINEB.EQ.¢) ISPAN=N 


STP1642¢ 
STP1043¢ 
STP16440 
STP1045¢ 
STP10466 
STP106476 
STP1648@ 
STP16490 
STP10500 
STP16510 
STP16520 
STP1653¢ 
STP1054@ 
STP1955@ 
STP10560 
STP10570 
STP1658¢6 
STP14590 
STP16600 
STP1061@ 
STP1G62¢ 
STP16630 
STP10640 
STP1965¢ 
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STP2007¢ 
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STP26100 
STP2911¢ 
STP29120 
STP2013¢ 
STP20140 
STP20150 
STP26160 
STP20170 
STP2018¢6 
STP2019¢ 
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STP26216 
STP2022¢ 
STP 26230 
STP26246 
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STP2026¢ 
STP20276 
STP2028¢@ 
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STP2033¢ 
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LNPTR= (ISPAN-1)*IBDIM 
DO 216 ICOMP=1,M 
LNPTR=LNPTR+1 
B(LNPTR)=B (LNPTR)+A (ICOMP) 
CHECK FOR POSSIBLE REDUCTION IN COMPUTATION IN THE 
CONSTANT COEFFICIENT CASE. 
IF(LINEA.GT.N) GO TO 24¢ 
IF ((ITYPE.EQ.@) .AND. (ISPANA.EQ.ISPANB)) GO TO 225 
THE FOLLOWING CODE IS EXECUTED WHEN NO REDUCTION 
IN COMPUTATION IS POSSIBLE. 
LNPTR= (LINE-1)*IBDIM 
DO 220 ICOMP=1,M 
LNPTR=LNPTR+1 
A(ICOMP)=B (LNPTR) 
INDXRT=LINEB+J2 
INDXTN=LINE+1 
CALL TRI1(M,MIYPE,TM1,1TM2,ISPANA,R(INDXRT) ,TN2 (INDXTN) , 
A(1),A(M1) ,A(M2)) 
INDXRT=INDXRT+ISPANA 
IRTDIF=LINEBtJ1 
ISPAN=ISPANB-1 
CALL TRI2(M,MTYPE,TM1,1TM2,ISPAN,R(INDXRT) ,R(IRTDIF) , 
A(1) ,A(M1) ,A(M2) ,A(M3) ) 
LNPTR= (LINEA-1)*IBDIM 
DO 23@ ICOMP=1,M 
LNPTR=LNPTR+1 
B(LNPTR)=B (LNPTR)+A (ICOMP) 
CONTINUE 


RETURN 


SUBROUTINE STEP3(N,NTYPE,IN2,M,MIYPE,TM1,TM2, 


IBDIM,B,NE,ND,ID,R,A) 
IN SUBROUTINE STEP3, THE UNKNOWNS ON THE ND SEPARATING 


LINES ARE DETERMINED. THE LINES ARE DETERMINED IN THE 
REVERSE ORDER THAT THEY WERE ELIMINATED IN STEP2. 
VERSION DATE: MARCH 1, 1977. 


REAL ID 
DIMENSION TN2(1),TM1(1) ,TM2(1),A(1),B(1),R(1), ID(1) 


NP1=N+1 

Mi=M+1 

M2=M1+M 

M3=M24+M 
ITYPE=NTYPE-(NTYPE/2)*2 
IN THE FOLLOWING SEGMENT OF CODE, THE SPECIAL LINE OF UNKNOWNS 
ASSOCIATED WITH PERIODIC BOUNDARY CONDITIONS IS DETERMINED. 
IF(NTYPE.LT.3) GO TO 27¢ 

NM1=N-1 

LNPTR=NM1*IBDIM 

‘DO 255 ICOMP=1,M 


LNPTR=LNPTR+1 
A(ICOMP )=B (LNPTR) 


INDXRT= (NE+1) *N+1 
IRTDIF=NE*N+1 
CALL TRI2(M,MTYPE,TM1,TM2,NM1,R(INDXRT) ,R(IRTDIF), 


A(1) ,A(M1) ,A(M2) ,A (M3) ) 


INDXRT=INDXRT+NM1 
CALL TRI1(M,MTYPE,TM1,TM2,1,R(INDXRT),TN2(NPL), 


A(1) ,A(M1) ,A\M2)) 


LNPTR=NM1* IBDIM 
L2=LNPTR-IBDIM 
T1=TN2(1) 

T2=TN2 (N) 

DO 265 ICOMP=1,M 


LNPTR=LNPTR+1 

L2=L2+1 

X=A (ICOMP) 

B(LNPTR)=X 

B(L2)=B (L2)+T2*X 
B(ICOMP)=B (ICOMP)+T1*X 


IF(NE.EQ.6) RETURN 

IN THE FOLLOWING SEGMENT OF CODE, THE UNKNOWNS ON THE 
REMAINING SEPARATING LINES ARE DETERMINED. 

DO 345 IIl=1,NE 


I=NE+1-I1 


STP26470 
STP26480 
STP20490 
STP 26560 
STP2051¢ 
STP20652@ 
STP20530 
STP26540 
STP20655¢ 
STP 20560 
STP2057@ 
STP20580 
STP2059@ 
STP 20600 
STP2961¢ 
STP29620 
STP20630 
STP 29640 
STP26650 
STP20660 
STP20679 
STP 2668¢ 
STP26690 
STP26700 
STP206710 
STP20720 
STP206730 
STP20740 


STP 20756 
STP20760 


STP30010 
STP3002¢ 
STP36030 
STP36040 
STP36050 
STP 30060 
STP306070 
STP3008¢ 
STP30090 
STP3G1060 
STP3011¢ 
STP396120 
STP 3913¢ 
STP3014¢ 
STP3015¢ 
STP3016¢ 
STP3017¢ 
STP3018¢ 
STP3619¢ 
STP36206¢ 
STP3021¢ 
STP3022¢ 
STP3923¢ 
STP3624¢ 
STP36250 
STP3926¢ 
STP3627¢ 
STP3028¢ 
STP34290 
STP363060 
STP3031¢ 
STP30320 
STP3933¢ 
STP30340 
STP30350 
STP3036¢ 
STP306370 
STP3038¢ 
STP3039¢ 
STP30406¢ 
STP30410 
STP3642¢ 
STP3043¢ 
STP3044¢ 
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T2mQekT 
Il=12/2 
Jl=(I-1)*N+1 
J2=I*N+1 
DO 345 LNINDX=11,ND,12 
’ LINE=ID (LNINDX+1) 
LINEA=LNINDX+1+11 
LiNEA=ID (LINEA) 
LINEB=LNINDX+1-11 
LINEB=ID (LINEB) 
ISPANA=LINEA-LINE-1 
ISPANB=LINE-LINEB-1 
IN THE FOLLOWING SEGMENT OF CODE, THE RIGHT HAND SIDE IS 
MODIFIED USING UNKNOWNS WHICH WERE SOLVED FOR ON A PREVIOUS 
STEP OF THE RECURSION. 
ISPAN=LINEB 
IF (LINEB.EQ.@) ISPAN=ID (ND+2) 
IF(ISPAN.GT.N) GO TO 295 
LNPTR= (ISPAN-1) *LBDIM 
DO 275 ICOMP=1,M 
LNPTR=LNPTR+1 
275 ACICOMP )=B (LNPTR) 
CHECK FOR POSSIBLE REDUCTION IN COMPUTATION IN THE 
CONSTANT COEFFICIENT CASE. 
IF ((ITYPE.EQ.1).OR.(LINEA.GT.N)) GO TO 285 
IF(ISPANA.NE.ISPANB) GO TO 285 
LNPTR= (LINEA-1)*IBDIM 
DO 28@ ICOMP=1,M 
LNPTR=LNPTR+1 
280 A(CICOMP)=A (ICOMP)+B (LNPTR) 
GO TO 3065 
THE FOLLOWING CODE IS EXECUTED WHEN NO REDUCTION 
IN COMPUTATION IS POSSIBLE. 
285 INDXRT=LINEB+J1 
INDXTN=LINEB+1 
CALL TRI1(M,MIYPE,TM1,TM2,ISPANB,R(INDXRT) ,TN2(INDXTN), 
1 A(1),A(M1) ,A(M2)) 
Tl=TN2 (LINE) 
LNPTR=(LINE-1)*IBDIM 
DO 29¢ ICOMP=1,M 
LNPTR=LNPTR+1 
290 B(LNPTR)=B (LNPTR)+T1*A (ICOMP) 
295 IF (LINEA.GT.N) GO TO 315 
LNPTR= (LINEA-1)*IBDIM 
DO 340 ICOMP=1,M 
LNPTR=LNPTR+1 
360 A (CICOMP)=B (LNPTR) 
365 INDXRT=LINE+J1 
INDXTN=LINE+1 
CALL TRI1(M,MTYPE,TM1,TM2,ISPANA,R(INDXRT) , TN2(INDXTW) , 
1 A(1) ,A(M1) ,A(M2)) 
Tl=TN2 (LINEA) 
LNPTR= (LINE-1)*IBDIM 
DO 316 ICOMP=1,M 
LNPTR=LNPTR+1 
31¢ B(LNPTR)=B(LNPTR)+T1*A (ICOMP) 
IN THE FOLLOWING SEGMENT OF CODE, WE SOLVE FOR THE NEW LINE 
OF UNKNOWNS, AND THEN MODIFY THE RIGHT HAND SIDES OF THE 
ND+1 SMALLER BLOCKS IN THE APPROPRIATE FASHION. 
315 LNPTR= (LINE-1)*IBDIM 
DO 33¢ ICOMP=1,M 
LNPTR=LNPTR+1 
330 ACICOMP )=B (LNPTR) 
INDXRT=LINEB+J2 
IRTDILF=LINEB+J1 
CALL TRI2(M,MTYPE,TM1,TM2,ISPANB,R(INDXRT) ,R(IRTDIF) , 
1 A(1) ,A(M1) ,A(M2) ,A(M3) ) 
INDXRT#LINE+J2 
IRTDIF=LINE+J1 
CALL TRI1(M,MTYPE,TM1L,1M2,1,R(INDXRT-1),TN2(NP1), 
1 A(1),A(ML) ,A(M2)) 
CALL TRI2(M,MTYPE,TM1 ,TM2,ISPANA,R(INDXRT) ,R(IRTDIF), 
1 A(1L) ,A(M1) ,A(M2) ,A (M3) ) 
LNPTR= (LINE-1)*IBDIM 
L2=LNPTR-IBDIM 
L1=LNPTR+IBDIM 


STP306450 
STP30460 
STP3047¢ 
STP3048¢ 
STP3049¢ 
STP 30560 
STP3051¢ 
STP3652¢ 
STP3053¢ 
STP30540 
STP3655¢ 
STP30560 
STP30657¢6 
STP3058@ 
STP3059¢ 
STP30600 
STP3061¢ 
STP3062¢ 
STP 30630 
STP3064¢ 
STP3065@ 
STP30660 
STP30670 
STP30680 
STP30690 
STP30700 
STP3071¢ 
STP3072¢ 
STP36730 
STP30746 
STP3075¢ 
STP3076¢ 
STP30770 
STP30780 
STP3079@ 
STP30800 
STP3081¢ 
STP30820 
STP30830 
STP36846 
STP30850 
STP30860 
STP3087¢ 
STP30880 
STP3089¢ 
STP346900 
STP30910 
STP3692¢ 
STP3093¢ 
STP39940 
STP34950 
STP30960 
STP30970 
STP 30980 
STP39990 
STP31060¢ 
STP3161¢ 
STP31620 
STP3103¢ 
STP310640 
STP310650 
STP31060 
STP3107¢ 
STP 310680 
STP31990 
STP3116¢ 
STP31110 
STP31120 
STP3113¢ 
STP3114¢ 
STP3115¢ 
STP3116@ 
STP3117¢ 
STP3118¢ 
STP3119¢@ 
STP31200 
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Tl=TN2 (LINE+1) STP31210 

T2=TN2 (LINE) STP3122¢ 

DO 345 ICOMP=1,M STP 31230 
LNPTR=LNPTR+1 STP3124¢ 

L1l=L1+1 STP31250 

L2=L2+1 STP31269 

X=A (ICOMP) STP3127¢ 
B(LNPTR)=X STP31280 
B(L1)=B(L1)+T1*xX STP31290 

345 B(L2)=B(L2)+T2*X STP31300 
RETURN STP31310 
END STP 31320 
SUBROUTINE STEP4(TN1,1TN2,M,MIYPE,1TM1,TM2, IBDIM,B,ND,ID,R,A) STP4001¢ 
IN SUBROUTINE STEP4, THE ND+1 SMALLER PROBLEMS ARE STP40026 
SOLVED USING THE MARCHING ALGORITHM. THIS COMPLETES STP40030 
THE BACKSOLUTION PHASE OF THE GENERALIZED MARCHING ALGORITHM.  STP4604¢ 
VERSION DATE: MARCH 1, 1977. STP40050 
REAL ID STP40060 
DIMENSION TN1(1),TN2(1),TM1(1),TM2(1),A(1),B(1),R(1),ID(1) STP46670 
M1=M+1 STP46080 
M2=M1+M STP4OG9¢ 
NDP1=ND+1 STP4016¢ 
DO 44¢ LNINDX=1,NDP1 STP40110 
LINE=ID (LNINDX) STP40126 
ISPAN=ID (LNINDX+1) STP4013¢ 
LSPAN=I SPAN-LINE-1 STP4614¢ 

CALL MARCH] (M,MTYPE,TM1,TM2,1TN1,TN2,IBDIM,B, STP4015@ 

1 ISPAN,LINE,1,A(1) ,A(M1)) STP40160 
INDXRT=LINE+1 STP4017¢ 
INDXTN=INDXRT+1 STP40180 

CALL TRI1(M,MTYPE,TM1,TM2,ISPAN,R(INDXRT) ,TN2(INDXTN) , STP4G190 

1 A(1),A(M1) ,A(M2)) STP46200 
CALL MARCH2(M,MTYPE,TM1,TM2,TN1,TN2,IBDIM,B, STP406210 

1 ISPAN, LINE,A(1),A(M1)) STP4622¢ 
446 CONTINUE STP40623¢ 
RETURN STP4024¢ 
END STP4062506 
SUBROUTINE TRI1(M,MTYPE,TM1,1TM2,ISPAN,R,S,V,U,E) TRI1Q910 
SUBROUTINE TRI1 SOLVES A LINEAR SYSTEM WHICH INVOLVES TRI10662¢ 

A POLYNOMIAL OF DEGREE ISPAN IN THE MATRIX TM. THE ZEROES OF TRI1¢03¢ 
THE POLYNOMIAL ARE A SUBSET OF THE SET OF EIGENVALUES TRI1004¢ 
COMPUTED DURING THE PREPROCESSING PHASE. THE LEADING COEFFICIENTTRI16¢5¢ 

IS GIVEN AS A PRODUCT OF ISPAN SCALARS STORED IN S. TRI1OG6G 
THE RIGHT HAND SIDE IS STORED IN V. THE SOLUTION IS COMPUTED TRI1067¢ 

BY SOLVING ISPAN LINEAR SYSTEMS INVOLVING THE FACTORS OF THE TRI1008@ 
POLYNOMIAL. FOUR COMPLETE LOOPS ARE INCLUDED; THE CORRECT LOOP TRI1¢6¢9¢ 
FOR A GIVEN PROBLEM IS DETERMINED BY THE VALVE OF MTYPE. TRI1G16¢ 
VERSION DATE: FEBRUARY 1, 1977. TRI19110 
DIMENSION TM1(1) ,T2(1),U(1),V(1),E(1),R(1),S(1) TRI1G¢12¢ 
MM1=M-~1 TRI1913¢ 
GO TO (3,506,206,75) ,MTYPE TRI1614@ 
THE LOOP FOR MTYPE = 1. TRI1G¢15¢@ 

3 DO 15 J=1,ISPAN TRI1O16¢ 
D=R(J) TRI10617@ 
DS=S(J) TRI1G618¢ 
U(1)=TM1 (1)4+D TRI1¢19¢ 

DO 5 ICOMP=2,M TRI1920¢ 
ICM1=ICOMP-1 TRI1921¢ 

Q=TM2 (ICOMP) /U (ICM1) TRI1622¢ 

V (ICOMP )=V (ICOMP)+V (ICM1)*Q TRI1923@ 

5 U CICOMP )=TM1 (ICOMP)+D-—Q*TM2 (ICOMP) TRI19624¢ 
Q=V (M) /U (M) TRI1925@ 
V(M)=Q*DS TRI1926@ 

DO 1@ II=1,MM1 TRI196276 
ICOMP=M-II TRI1928¢ 

Q=(V CICOMP)+TM2 (ICOMP+1)*Q) /U (ICOMP) TRI19629@ 

1¢ V CICOMP )=Q*DS TRI1463¢¢ 
15 CONTINUE TRI1031¢ 
RETURN TRI19632¢ 
THE LOOP FOR MTYPE = 3. TRI1933¢ 
20 DO 4@ J=1,ISPAN TRI19034¢ 


D=R(J) 


TRI19¢350 
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35 
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DS=S(J) 

U(1)=TM1 (1)-+D 

E(1)=TM2(1) 

DO 25 ICOMP=2,MM1 
ICM1=ICOM?-1 
Q=TM2 (ICOMP) /U(ICM1) 
V(ICOMP)=". (ICOMP)+V (ICM1)*Q 
U(ICOMP)="M1 (ICOMP)+D~Q*TM2 (ICOMP) 
E (ICOMP)=0*E (ICM1) 

E (MMI) =(E (MM1> +TM2 (M) ) /U (MM1) 

V (MM1)=V (MMI) /'U (MM1) 

DO 30 II=2,MM1 
ICOMP=M-II 
ICP 1=ICOMP+1 


V (LCOMP) = (V (LCOMP )+TM2(ICP1)*V(ICP1)) /U(ICOMP) 
E(ICOMP)=(E(ICOMP)+IM2(ICP1)*E(ICP1))/U(ICOMP) 


Q=TM1 (M)+D-TM2 (1) *E(1)-TM2 (M)*E (MM1) 
Q=(V (M)+TM2 (1) *V (1)+TM2 (M)*V(MM1) )/Q 
V (M)=Q*DS 
DO 35 ICOMP=1,MM1 

V (ICOMP )= (V (ICOMP) +E (LCOMP)*Q)*DS 
CONTINUE 


RETURN 


C THE LOOP FOR MTYPE = 2. 


5@ MM2=M-2 
T3=1.Q@E@/TM2 (3) 
T2=TM2 (2) *T3 
T4=TM2 (M)*T3 
DO 65 J=1,ISPAN 


55 


6¢ 


65 


D=R(J) 
DS=S(J)*13 
U(1)=TM2 (3) / (TM1(1)+D) 
T1l=(TM1 (2)+D)*T3 
Q=T24*U (1) 
V(2)=V (2)+V(1)*Q 
U(2)=1 .GEG/ (T1-Q*T2) 
DO 55 ICOMP=3,MMI1 
ICM1=ICOMP-1 
V CICOMP) =V (ICOMP)-+V (ICM1)*U (ICM1) 
UC ICOMP)=1.@E@/ (T1-U (ICM1)) 
Q=T4*U (MM1) 
V(M)=V (M)+V (MM1)*Q 
U (M)=(TM1 (M)+D) *T3-Q*T4 
Q=V (M) /U (M) 
V(M)=Q*DS 
Q= (VV (MM1)+Q*T4)*U (MM1) 
V (MM1)=Q*DS 
DO 6@ II=2,MM2 
ICOMP=M~II 
Q=(V (ICOMP )+Q)*U (ICOMP) 
V (ICOMP )=Q*DS 
Q=(V(1)+T2*Q)*U (1) 
y(1)=Q*Ds 
CONTINUE 


RETURN 


Cc THE LOOP FOR MTYPE = 4. 


75 T2=1.0E6/TM2 (2) 
Ml=MM1/2 
MLP1=M1+1 
MIP2=M1+2 
MIP3=M1+3 
MSW=M-(M/2)*2 
M2=M1-MSW 
RM=1.@E@ 
RA=1.GE@ 


IF(MSW.EQ.1) GO TO 8¢ 


RM=2.@E@ 
RA=0.@E@ 
8¢ DO 85 ICOMP=1,Ml 


85 


JCOMP=M+MSW-ICOMP 
Q=(V (JCOMP)-V (ICOMP) )/2.GE@ 
V(JCOMP)=(V(JCOMP)+V (ICOMP) )/2.GE@ 
V(ICOMP)=Q 


DO 115 J=1,ISPAN 


D=R (J) 
DS=S (J)*T2 


TRI1036¢ 
TR1I1937@ 
TRI1038¢@ 
TRI10639¢ 
TRI10460 
TRI10641@ 
TRI19420 
TRI14¢43@ 
TRI1644¢ 
TRI1645@ 
TRI10460 
TRI1647¢ 
TRI1648¢ 
TRI1G¢490 
TRI1G650¢ 
TRI1O51¢ 
TRI10652@ 
TRI1053@ 
TRI1054@ 
TRI1G655@ 
TRI10560 
TRI16570 
TRI1658¢ 
TRI1659¢ 
TRI1060¢ 
TRI1061¢6 
TRI1@620 
TRI1663¢ 
TRI1664¢ 
TRI1665@ 
TRI1¢660 
TRI1667¢ 
TRI1668¢ 
TRI1¢690 
TRI10706¢ 
TRI10719 
TRI1672¢ 
TRI1¢73@ 
TRI1674@ 
TRI10675@ 
TRI10760 
TRI106776 
TRI10780 
TRI1079@ 
TRI14800 
TRI1981¢ 
TRI1082¢ 
TRI146830 
TRI1084@ 
TRI1085¢ 
TRI16860 
TRI1087@ 
TRI1¢88¢ 
TRI1G¢890 
TRI19960 
TRI1691¢ 
TRI1692¢ 
TRI1693¢ 
TRI10694@ 
TRI1995¢ 
TRI10960 
TRI10697¢ 
TRI16980@ 
TRI16990 
TRI110060 
TRI1191¢ 
TRI11¢62¢ 
TRI1103¢ 
TRI1194@ 
TRI1195@ 
TRI1196@ 
TRI11907¢ 
TRI1168¢ 
TRI11909¢ 
TRI11106¢ 
TRI1111¢ 
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96 


95 


165 


11¢ 
115 


12¢ 


Tl=(TM1(1)4D)*T2 
U(1)=1.@E@/(T1+RA) 
DO 96 ICOMP=2,M1 

ICM1=ICOMP-1 

VCICOMP)=V (ICOMP)+V (ICM1)*U (ICM1) 

U (ICOMP)=1.@E@/ (T1-U (ICM1)) 
U(MIP1)=1.@E¢6/T1 
V(M1P2)=V (M1P2)+V (MIP1)*U (M1P1) 
U(M1P2)=1.@E@/(T1-2.@EQ@*U (MIP1) ) 
DO 95 ICOMP=M1P3,MM1 

ICM1=ICOMP-1 

V CLICOMP)=V (ICOMP)+V (ICM1) *U (ICM1) 

Uc ICOMP)=1.GE@/ (T1-U (ICM1) ) 
V (M) =V (M)+V (MM1) *U (MM1) *RM 
U (M) =T1—RM*U (MM1) -RA 
Q=V (M) /U (M) 

V(M)=Q*DS 
DO 105 II=1,M2 

ICOMP=M-II 

Q=(V (ICOMP)+Q)*U (ICOMP ) 

V (LCOMP)=Q*DS 
Q=(V(MLP1)+2.@E@*Q)*U (MIP1) 
V(MIP1)=Q*DS 
Q=V (M1) *U (M1) 

V (M1)=Q*DS 
DO 11@ II=2,M1 

ICOMP=M1P1-I1 

Q=(V (ICOMP)+Q)*U (LCOMP ) 

V CICOMP )=Q*DS 

CONTINUE 

DO 12@ ICOMP=1,M1 
JCOMP=M+MSW-ICOMP 
Q=V (JCOMP )-V (ICOMP) 
V(JCOMP)=V (JCOMP)+V (ICOMP ) 
V CICOMP)=Q 

RETURN 

END 


SUBROUTINE TRI2(M,MTYPE,TM1,1M2,ISPAN,R1,R2,V,W,U,E) 
SUBROUTINE TRI2 SOLVES A LINEAR SYSTEM WHICH INVOLVES 
A RATIONAL FUNCTION OF THE MATRIX TM. THE DEGREE OF BOTH THE 
NUMERATOR AND THE DENOMINATOR IS ISPAN. THE ZEROES OF BOTH 
POLYNOMIALS ARE SUBSETS OF THE EIGENVALUES CALCULATED DURING 
THE PREPROCESSING PHASE. THE ZEROES OF THE NUMERATOR ARE 
STORED IN R1; THE ZEROES OF THE DENOMINATOR ARE STORED IN R2. 
THE LEADING COEFFICIENT OF BOTH POLYNOMIALS IS 1.¢. THE 
RIGHT HAND SIDE IS STORED IN V. THE SOLUTION IS COMPUTED BY 
SOLVING ISPAN LINEAR SYSTEMS INVOLVING THE FACTORS OF THE 
POLYNOMIAL WHICH APPEARS IN THE NUMERATOR. A CHECK FOR 
COMMON FACTORS IS CARRIED OUT, AND THEY ARE CANCELLED IF 
FOUND. FOUR COMPLETE LOOPS ARE PROVIDED; THE CORECT LOOP 
FOR A GIVEN PROBLEM IS DETERMINED BY THE VALUE OF MTYPE. 
VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION TM1(1),TM2(1),V(1),U(1),W(1) ,E(1),R1(1) ,R2(1) 
COMMON /MACHEP/TOL 
TOL2=8 .@EO*TOL 
MM1=M-1 
GO TO (3,50,20,75) ,MTYPE 
THE LOOP FOR MIYPE = 1. 
DO 15 J=1,ISPAN 
D=R1 (J) 
DR=R2(J)-D 
U(1)=TM1 (1)+D 
Q=ABS (DR/U(1)) 
IF(Q.LE.TOL2) GO TO 15 
W(1)#V(1) 
DO 5 ICOMP=2,M 
ICM1=ICOMP-1 
Q=TM2 (ICOMP) /U(ICM1) 
W(ICOMP)=V (ICOMP)+W(ICM1)*Q 
U (ICOMP )=TM1 (ICOMP)+D-Q*TM2 (ICOMP) 
Q=W (M) /U (M) 
V(M)=V (M)+DR*Q 
DO 1¢ II=1,MM1 
ICOMP=M-II 


TRI1112@ 
TRI1113¢ 
TRI1114@ 
TRI1115@ 
TRI1116@ 
TRI1117@ 
TRI1118@ 
TRI1119¢ 
TRI112¢60 
TRI11219 
TRI11220 
TRI11230 
TRI11246 
TRI1125¢ 
TRI1126¢ 
TRI1127¢ 
TRI1128@ 
TRI11290 
TRI113@¢ 
TRI11310 
TRI1132@ 
TRI1133@ 
TRI1134@ 
TRIL135¢@ 
TRI1136@ 
TRI11370 
TRI1138@ 
TRI1139¢ 
TRI1140@ 
TRI11419 
TRI11420 
TRI11436 
TRI1144¢ 
TRI11450 
TRI1146@ 
TRI1147@ 
TRI1148@ 


TRI2601¢ 
TRI2002¢ 
TRI20630 
TRI2004¢6 
TRI200650 
TRI20066¢6 
TRI 20070 
TRI260680 
TRI2¢69¢6 
TRI2¢100 
TRI20110 
TRI2¢120 
TRI2¢13@ 
TRI20614¢@ 
TRI2015¢@ 
TRI2¢16@ 
TRI2017¢ 
TRI2018@ 
TRI2G¢190 
TRI2020¢ 
TRI2¢6210 
TRI20220 
TRI 26230 
TRI2¢240 
TRI2025@ 
TR12026@ 
TRI2¢627¢ 
TRI2028¢ 
TRI20¢290 
TRI20300 
TRI20310 
TRI2¢632@ 
TRI2¢330 
TRI2¢24@ 
TRI2035@ 
TRI2036@ 
TRI2637@ 
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19 


15 


Cc 


20 


25 


3¢ 


35 
49 


5¢ 


55 


60 


65 


75 


Qs (W( ICOMP )+TM2 (ICOMP+1)*Q) /U (ICOMP ) 
V (ICOMP )=V (ICOMP)+DR*Q 
CONTINUE 
RETURN 
THE LOOP FOR MTYPE = 3. 
DO 4@ J=1,ISPAN 
D=R1 (J) 
DR#=R2(J)-D 
U(1)=M1 (1)+D 
Q=ABS (DR/U(1)) 
IF(Q.LE.TOL2) GO TO 4¢ 
W(1)=V(1) 
E(1)=1M2(1) 
DO 25 ICOMP=2,MMI1 
ICM1=ICOMP-1 
Q=TM2 (ICOMP) /U (ICM1) 
W(ICOMP)=V (ICOMP)+W(ICM1)*Q 
U(ICOMP)=TM1 (ICOMP )+D-Q*TM2 (ICOMP) 
E (ICOMP)=Q*E (ICM1) 
E(MM1)=(E(MM1)+TM2 (M) )/U (MM1) 
W(MM1)=W(MM1) /U (MM1) 
DO 3@ II=2,MM1 
ICOMP=M-IL 
ICP 1=ICOMP+1 
W(ICOMP) = (W(ICOMP)+TM2 (ICP1)*W(ICP1))/U(ICOMP) 
E(ICOMP)=(E(ICOMP)+TM2(ICP1)*E(ICP1))/U(ICOMP) 
Q=TM1 (M)+D-TM2 (1) *E(1)-TM2 (M)*E (MM1) 
Q= (V(M)+TM2 (1)*W(1)-+TM2 (M)*W(MM1))/Q 
V(M)=V (M)+DR*Q 
DO 35 ICOMP=1,MM1 
V (ICOMP)=V (ICOMP)+DR* (W(ICOMP )+E (ICOMP) *Q) 
CONTINUE 
RETURN 
THE LOOP FOR MTYPE = 2. 
MM2=M-2 
T3=1.@EQ/TM2 (3) 
T2=TM2 (2)*T3 
T4=TM2 (M)*T3 
DO 65 J=1,ISPAN 
DeR1 (J) 
DR=(R2(J)-D)*T3 
~ U(1)=TM2 (3) / (TM1 (1)+D) 
Q=ABS (DR*U(1)) 
IF(Q.LE.TOL2) GO TO 65 
W(1)=V(1) 
T1=(TM1(2)+D)*T3 
Q=T2*U (1) 
W(2)=V (2) +W(1)*Q 
U(2)=1 .GEO/ (T1-Q*T2) 
DO 55 ICOMP=3,MM1 
ICM1=ICOMP-1 
W(ICOMP)=V (ICOMP)+W(ICM1)*U(ICM1) 
UC ICOMP)=1.@E@/ (T1-U (ICM1)) 
Q=T4*U (MM1) 
W(M)=¥V (M)+W(MM1)*Q 
U(M)=(TM1 (M)+D) *T3-Q*T4 
Q=W(M) /U(M) 
V(M) =V (M)+DR*Q 
Q= (W(MM1)+Q*T4)*U (MM1) - 
V (MM1)=V (MM1)+DR*Q 
DO 66 IIl=2,MM2 
ICOMP=M-II 
Q= (W(ICOMP)+Q)*U (ICOMP) 
V (ICOMP )=V (ICOMP)+DR*Q 
 Q=(W(1)+T24Q)*U (1) 
V(1)=V(1)+DR*Q 
CONTINUE 
RETURN 
THE LOOP FOR MTYPE = 4. 
T2=1.@E0/TM2 (2) 
Ml=MM1/2 
M1P1=M1+1 
M1P2=M1+2 
M1P3=M1+3 
MSW=M—(M/2)*2 
M2=M1-MSW 


TRI24638¢@ 
TRI2039¢ 
TRI204606 
TRI206410 
TRI2042¢ 
TRI20430 
TRI2044¢ 
TRI20450 
TRI20460 
TRI206476 
TRI2048¢ 
TRI26496 
TRI2650¢ 
TRI2051@ 
TRI2052¢ 
TRI26530 
TRI206546 
TRI2055@ 
TRI20569 
TRI2057@ 
TRI20580 
TR1I2659@ 
TRI20600 
TRI2061¢6 
TRI 206620 
TRI2¢63@ 
TRI20640 
TRI20650 
TRI2066¢ 
TRI20670 
TR1I2068¢ 
TRI2069¢0 
TRI206700 
TRI 206710 
TRI26720@ 
TRI26730 
TRI206740 
TRI2675@ 
TRI26760 
TRI2677@ 
TRI2078¢@ 
TRI2079@ 
TRI2¢800 
TRI2081¢ 
TRI2982@ 
TRI2983¢@ 
TRI2¢84¢ 
TRI2085¢ 
TRI2086¢ 
TRI2¢87¢ 
TRI2088@ 
TRI2489@ 
TRI2¢96¢ 
TRI20910 
TRI20692@ 
TRI2693¢ 
TRI2694¢ 
TRI2095¢ 
TRI2¢960 
TRI20970 
TRI2498¢ 
TRI2¢99¢ 
TRI210600 
TRI21¢1¢@ 
TRI21626 
TRI2163@ 
TRI21040 
TRI21650 
TRI2196¢ 
TRI21070 
TRI2168@ 
TRI2169¢ 
TRI2114¢ 
TRI2111¢ 
TRI2112¢ 
TRI2113¢ 
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aqQaa 


agaaaanaa 


89 


85 


96 


95 


165 


11¢ 
115 


12¢ 


RM=1.@E@ 

RA=1 .GE@ 

IF(MSW.EQ.1) GO TO 8¢ 

RM=2.@E@ 

RA=@.GE@ 

DO 85 ICOMP=1,M1 
JCOMP=M+MSW-ICOMP 
Q=(V(JCOMP)-V (ICOMP) )/2.G@E@ 
V (JCOMP)=(V(JCOMP)+V (ICOMP) )/2.@E@ 
V(ICOMP)=Q 

DO 115 J=1,ISPAN 
D=R1 (J) 

DR=(R2(J)-D)*T2 

T1=(TM1 (1)+D)*T2 
U(1)=1.@E@/ (T1+RA) 
Q=ABS (DR*U (1)) 
IF(Q.LE.TOL2) GO TO 115 
W(1)=V(1) 

DO 9¢ ICOMP=2,MI1 

ICM1=ICOMP-1 

WCICOMP)=V (ICOMP)+W(ICM1)*U(ICM1) 

U (ICOMP)=1 .@E@/ (T1-U (ICM1)) 
U(MIP1)=1.@E@/T1 
W(M1P1)=V(M1P1) 

W(M1P2)=V (M1P2)+W(MI1P1)*U(MIP1) 
U(MLP2)=1.@E@/(T1-2.@E@*U (MIP1)) 
DO 95 ICOMP=M1P3,MM1 

ICM1=ICOMP-1 

W(ICOMP)=V (ICOMP)+W (ICM1)#*U (ICM1) 

U(ICOMP)=1 .GE@/ (T1-U (ICM1) ) 
W(M)=V (M)-+W (MM1) *U (MM1) *RM 
U(M)=T1-RM*U (MM1)-RA 
Q=W (M) /U (M) 

V (M)=V (M)+DR*Q 
DO 165 II=1,M2 

ICOMP=M-II 

Q=(W(ICOMP)+Q)*U (ICOMP) 

V (ICOMP)=V (ICOMP)+DR*Q 
Q=(W(MIP1)+2 .@EG*Q)*U (MIP1) 
V(M1P1)=V (M1P1)+DR*Q 
Q=W (M1) *U (M1) 

V(M1)=V(M1)+DR*Q 
DO 11@ II=2,M1 

ICOMP=M1P1-II 

Q= (W(ICOMP)+Q)*U (ICOMP) 

V (ICOMP )=V (ICOMP)+DR*Q 

CONTINUE 

DN 12¢ ICOMP=1,M1 
JCOMP=M+MSW-ICOMP 
G=V (JCOMP)-V (ICOMP) 
V (JCOMP )=V (JCOMP)-+V (ICOMP) 
V(ICOMP)=Q 

RETURN 

END 


SUBROUTINE MARCHI (M,MTYPE,TM1,1M2,TN1,TN2,IBDIM,B, 
ISPAN, LINE@, IALPHA,V1,V2) 
IN SUBROUTINE MARCH1, THE INITIAL MARCHING PHASE OF THE 


TRI2114¢ 
TRI2115¢@ 
TRI2116¢ 
TRI2117@ 
TRI2118¢ 
TRI2119¢ 
TRI21260 
TRI21210 
TRI2122@ 
TRI2123@ 
TRI2124@ 
TRI2125@ 
TRI21260 
TR1I2127@ 
TRI21280 
TRI21290 
TRI21300 
TRI21310 
TRI2132@ 
TRI21330 
TRI2134@ 
TRI2135@ 
TRI2136@ 
TRI2137@ 
TRI2138@ 
TRI21390 
TRI2140@ 
TRI2141@ 
TRI21426 
TRI2143@ 
TRI2144@ 
TRI2145@ 
TRI2146@ 
TRI21470@ 
TRI2148¢ 
TRI2149¢ 
TRI215¢@ 
TRI215106 
TRI21520 
TRI21530 
TRI2154@ 
TRI21550 
TRI21560 
TRI2157@ 
TRI2158¢@ 
TRI2159@ 
TRI21660 
TRI2161¢ 
TRI2162¢ 
TRI21630 
TRI2164@ 
TRI2165¢@ 
TRI21660 
TRI2167@ 


MCH1¢¢1¢ 
MCH146920 
MCH1903¢ 


MARCHING ALGORITHM IS CARRIED OUT. ISPAN IS THE NUMBER OF LINESMCH14604@ 


PRESENT. INFORMATION ABOUT THE DIRECTION OF THE MARCH, AND 
THE SCALARS WHICH MULTIPLY THE MARCHING VECTORS AT EACH STAGE 
IS STORED IN IALPHA. THE BOUNDARY LINE FOR THE MARCH IS LINE®@. 
THE MARCHING VECTORS ARE V1 AND V2. THE RESULT IS RETURNED IN 
THE VECTOR V1. 
VERSION DATE: MARCH 1, 1977. 

DIMENSION TM1(1) ,1TM2(1),TN1(1) ,TN2(1),B(1),V1(1) ,V2(1) 
LINE=LINEG+IALPHA 
IBETA= (IALPHA+1) /2 
IBETA=LINE+LBETA 
BETA=TN2 (IBETA) 
BETA1=-1.@E@/BETA 
LNPTR= (LINE-1)*IBDIM 
DO 5 ICOMP=1,M 

LNPTR=LNPTR+1 

V1 (ICOMP)=B (LNPTR) *BETAL 


MCH10065¢ 
MCH1G06¢ 
MCH10067@ 
MCH1468¢@ 
MCH14609@ 
MCH1916¢ 
MCH1@11¢ 
MCH1@¢12@ 
MCH1¢13@ 
MCH1O14@ 
MCH1O15@ 
MCH1916@ 
MCH1G17@ 
MCH1@18¢@ 
MCH10619@ 
MCH19206¢ 
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5 


15 


20 


15 


V2(ICOMP)=@.GE@ 
IF(ISPAN.EQ.1) RETURN 
MM1=M-1 
TC=@.GE@ 

IF (MTYPE.GE.3) TC=TM2(1) 
DO 20 I=2,ISPAN 

LINE=LINE+IALPHA 

IBETA=IBETA+IALPHA 

LNPTR= (LINE-1)*IBDIM 

ALPHA=TN1 (LINE) 

BETA2=BETA 

BETA="IN2 (IBETA) 

BETA1=1.@E0/BETA 

XM=V 1 (M) 

XB=V1(1) 

XC=XB 

TB=TC 

DO 15 ICOMP=1,MM1 

LNPTR=LNPTR+1 

XT=XM 

XM=XB 

XB=V1 (ICOMP+1) 

TT=TB 

TB=TM2 (ICOMP+1) 

Q=B (LNPTR)+BETA2*V2 (ICOMP)+TT*XT+TB*XB 


V1 (ICOMP)=( (TM1 (ICOMP )+ALPHA) *XM-Q) *BETA1 


V2 (ICOMP) =XM 
Q=B (LNPTR+1)+BETA2*V2 (M)+TB*XM+TC*XC 
V1 (M)=( (TMI (M)+ALPHA)*XB-Q) *BETA1 
V2 (M)=XB 
RETURN 
END 


SUBROUTINE MARCH2 (M,MTYPE,TM1,1M2,1N1,TN2,IBDIM,B, 


ISPAN , LINE@ ,V1,V2) 


IN SUBROUTINE. MARCH2, THE FINAL MARCHING PHASE OF THE 


MCH1421¢6 
MCH16226 
MCH1623¢ 
MCH1@24¢@ 
MCH1025@ 
MCH1@26¢ 


MCH1@27@ 


MCH1¢28¢@ 
MCH1629¢ 
MCH1063066 
MCH1631¢ 
MCH106326 
MCH1933@ 
MCH14634¢ 
MCH1¢35@ 
MCH1O636¢ 
MCH1637@ 
MCH1@380 
MCH1939¢ 
MCH1646¢ 
MCH1041¢ 
MCH1942¢ 
MCH19430 
MCH1044¢ 
MCH146450 
MCH1046@ 
MCH10647@ 
MCH1@48¢@ 
MCH1¢49¢ 
MCH10500 
MCH1¢51¢ 
MCH196520 


MCH2001¢ 
MCH200620 
MCH24030 


MARCHING ALGORITHM IS CARRIED OUT. ISPAN IS THE NUMBER OF LINESMCH2@64¢ 
PRESENT. THE BOUNDARY LINE FOR THE MARCH IS LINE@. THE MARCHINGMCH2¢65¢ 
VECTORS ARE V1 AND V2. AS THE MARCHING PROCEEDS, THE SOLUTION ISMCH2¢06¢ 


WRITTEN OVER THE RIGHT HAND SIDE B. 
VERSION DATE: MARCH 1, 1977. 


DIMENSION TM1(1),TM2(1),TN1(1),TN2(1),B(1),V1 (1) ,V2(1) 


LINE=LINE@ 
DO 5 ICOMP=1,M 
V1 (ICOMP)=-V1 (ICOMP) 
V2 (ICOMP)=0.@E@ 
IF(ISPAN.EQ.1) GO TO 25 
MM1=M-1 
BETA=TN2 (LINE+1) 
TC=¢.GE@ 
IF (MTYPE.GE.3) TC=TM2(1) 
DO 26 I=2,ISPAN 
LINE=LINE+1 
LNPTR= (LINE-1)*IBDIM 
ALPHA=TN1 (LINE) 
BETA2=BETA 
BETA=TN2 (LINE+1) 
BETA1=1.@E@/BETA 
=V1(M) 
XB=V1(1) 
XC=XB 
TB=TC 
DO 15 ICOMP=1,MMI1 
LNPTR=LNPTR+1 
XT=XM 
XM=XB 
XB=V1 (ICOMP+1) 
TT=TB 
TB=TM2 (ICOMP+1 ) 
Q=B (LNPTR)+BETA2*V2 (ICOMP)+TT*XT+TB*XB 


V1 (LCOMP)=((TM1 (ICOMP)+ALPHA) *XM-Q)*BETAL 


V2 (ICOMP)=XM 

B(LNPTR)=XM 
Q=B (LNPTR+1)+BETA2*V2 (M)+TB*XM+TC*XC 
V1 (M)=( (TMI (M)+ALPHA) *XB-Q)*BETA1 


MCH20067¢ 
MCH2G0806 
MCH2609¢ 
MCH2016¢ 
MCH2¢611¢ 
MCH20120 
MCH2@13@ 
MCH2¢14¢ 
MCH2015¢@ 
MCH20616¢@ 
MCH2@17¢ 
MCH2418¢ 
MCH2019¢ 
MCH2062060 
MCH2421@ 
MCH246226 
MCH24230 
MCH2924@ 
MCH2@25@ 
MCH20260 
MCH2@27@ 
MCH2¢28@ 
MCH2¢29¢ 
MCH20300 
MCH20631¢ 
MCH206326 
MCH2033¢@ 
MCH2034@ 
MCH2035¢ 
MCH2036@ 
MCH20637¢6 
MCH20380 
MCH24639@ 
MCH2046¢6 
MCH20416 
MCH2042¢ 
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aa 
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20 
25 


3¢ 


15 


2¢ 


V2 (M)=XB 
B(LNPTR+1)=XB 
LNPTR#=LINE* IBDIM 
DO 3¢@ ICOMP=1,M 
LNPTR=LNPTR+1 
B(LNPTR)=V1 (ICOMP) 
RETURN 
END 


SUBROUTINE MARCH3(M,MTYPE,TM1 ,TM2,TN1,TN2,IBDIM,B, 

ISPAN ,LINE@, LINEC,V1,V2) 

IN SUBROUTINE MARCH3, THE INITIAL MARCHING PAHSE OF THE 
MARCHING ALGORITHM IS CARRIED OUT, FOR CONSTANT COEFFICIENT 
PROBLEMS MEETING CERTAIN REQUIREMENTS. ISPAN IS THE NUMBER OF 
LINES PRESENT. MARCHING OCCURS IN BOTH DRRECTIONS FROM THE 
BOUNDARY LINE LINE@. THE MARCHING VECTORS ARE V1 AND V2. 
VERSION DATE: MARCH 1, 1977. 

DIMENSION TM1(1),TM2(1),TN1(1),TN2(1),B(1),V1(1) ,V2(1) 
LINE=LINE@-1 
LINN=LINEC+1 
BETA=TN2 (LINE) 

BETA1=-1.@E@/BETA 
LNPTR=(LINE-1)*IBDIM 
NNPTR= (LINN-1)* IBDIM 
DO 5 ICOMP=1,M 

LNPTR=LNPTR+1 

NNPTR=NNPTR+1 

V1 (ICOMP) =(B(LNPTR)+B(NNPTR) )*BETAL 

V2(ICOMP)=@.@E@ 

IF(ISPAN.EQ.1) RETURN 
MM1=M-1 

TC=%.GE@ 

IF (MTYPE.GE.3) TC=TM2(1) 
DO 2@ I=2,1SPAN 

LINE=LINE-1 

LINN=LINN+1 

LNPTR= (LINE-1)*IBDIM 

NNPTR= (LINN-1)*IBDIM 

ALPHA=TN1 (LINE) 

BETA2=BETA 

BETA=TN2 (LINE) 

BETAl=1.G@E0/BETA 

XM=V1 (M) 

XB=V1(1) 

XC=XB 

TB=TC 

DO 15 ICOMP=1,MM1 

LNPTR=LNPTR+1 

NNPTR=NNPTR+1 

XT=XM 

XM=XB 

XB=V1 (ICOMP-+1) 

TT=TB 

TB=TM2 (ICOMP+1) 

Q=B (LNPTR)+B (NNPTR)+BETA2*V2 (ICOMP)+TT*XT+TB*XB 
V1 (ICOMP) =( (TM1 (ICOMP )+ALPHA) *XM-Q) *BETAL 
V2(ICOMP) =XM 

Q=B (LNPTR+1)+B (NNPTR+1)+BETA2*V2 (M)+TB*XM+TC*XC 

V1(M)=( (TM1 (M)+ALPHA) *XB-Q)*BETA1 

V2 (M)=XB 
RETURN 
END 


SUBROUTINE GMAS (NPC,N,NTYPE,TN1,TN2,M,MTYPE,1M1,1M2, 

IBDIM,B,VN,VM,K,R,A) 

SUBROUTINE GMAS IS USED IN PLACE OF SUBROUTINE GMA FOR 
SOLVING, IN THE LEAST SQUARES SENSE, LINEAR SYSTEMS IN WHICH 
THE MATRIX IS POSITIVE OR NEGATIVE SEMI-DEFINITE HAVING 
ZERO AS AN EIGENVALUE OF MULTIPLICITY ONE. 

THE LINEAR SYSTEM HAS THE FORM: 


( TMLC(L) + TNI(J) ) * X(I,J) 
- T™M2(I+1) * X(I41,J) - TM2(I) * X(I-1,J) 
- TN2(J+1) * X(I,J+1) - TN2(J) * X(I,J-1) = B(I,J) 


MCH2643¢ 
MCH2044¢ 
MCH20450@ 
MCH2046¢ 
MCH2047@ 
MCH2048¢ 
MCH20649¢ 
MCH2050¢ 


MCH3001¢ 
MCH3002¢ 
MCH30030 
MCH3004¢ 
MCH30@50 
MCH30060 
MCH30067¢ 
MCH300680 
MCH3009¢ 
MCH3010@ 
MCH3911¢ 
MCH3¢12¢ 
MCH3013¢ 
MCH3@14@ 
MCH3615@ 
MCH3016¢ 
MCH3¢17¢ 
MCH30180 
MCH3919¢ 
MCH3062060 
MCH3021¢ 
MCH3@22@ 
MCH3623¢ 
MCH3@24@ 
MCH30250 
MCH3@266 
MCH3027¢ 
MCH3@28@ 
MCH30290 
MCH3036¢ 
MCH3031¢ 
MCH390320 
MCH3033@ 
MCH3034@ 
MCH30350 
MCH3036¢ 
MCH3037@ 
MCH3038@ 
MCH30390 
MCH30440 
MCH3041¢ 
MCH304 26 
MCH3043¢ 
MCH30440 
MCH3045¢ 
MCH30460 
MCH30476 
MCH30480 
MCH3049¢ 
MCH3050@ 
MCH3@510 
MCH3@520 
MCH30530 


GMASOG1¢ 
GMASG9O20 
GMASO¢30 
GMASGO40 
GMASG¢065@ 
GMASOG60 
GMAS@67¢ 
GMASOO8¢ 
GMASG990 
GMAS@100 
GMAS@11¢ 
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GMAS@12@ 

FOR I = 1,2,...,M, AND J = 1,2,...,N, WHERE TM2(M+1) IS GMAS@13¢ 
INTERPRETED AS TM2(1), TN2(N+1) AS TN2(1), X(@,J) AS X(M,J), GMAS@14¢ 
X(M+1,J) AS X(1,J), X(I,@) AS X(I,N), AND X(I,N+1) AS X(I,1). GMASO15¢ 
GMAS@16¢ 

THE PARAMETER LIST: GMAS@17¢ 
GMASO18¢ 

NPC IS AN INTEGER. IF NPC = @, GMAS DOES NECESSARY GMAS@19¢ 
PREPROCESSING CALCULATIONS. IF NPC = 1, GMAS SOLVES THE GMASG20¢ 
LINEAR SYSTEM. GMASG$21@ 

N IS AN INTEGER, AS DEFINED ABOVE. N MUST BE GREATER THAN 2. GMAS@22@ 
NTYPE IS AN INTEGER DESCRIBING THE ARRAYS TN1 AND TN2. GMAS@23¢ 
NIYPE = 1: GENERAL SEPARABLE - DIRICHLET, NEUMANN, OR GMAS@24¢ 
MIXED BOUNDARY CONDITIONS. GMAS@25¢ 
TN1(I) IS ARBITRARY, I = 1,2,...,N. GMASG260 
TN2(1) = 6.@; TN2(1) IS ARBITRARY, NONZERO, I = 2,3,...,N. GMAS@27¢ 
NIYPE = 2: CONSTANT COEFFICIENT - DIRICHLET, NEUMANN, GMASG28¢ 

OR MIXED BOUNDARY CONDITIONS. GMASO29¢ 
TN1(Z) = ALPHA, ALPHA AN ARBITRARY CONSTANT, I = 2,3,...N-1.GMASO3¢0 
TN2(1) = 6.@; TN2(L) = BETA, BETA AN ARBITRARY NONZERO GMASG31¢ 
CONSTANT, I = 3,...,N-l. GMAS@320 

TOP BOUNDARY CONDITION : ONE OF GMASG33¢ 
TN1(1) = ALPHA; N2(2) = BETA; (DIRICHLET) GMAS@34¢ 
TN1(1) = ALPHA; TN2(2) = SQRT(2) * BETA; (NEUMANN-CENTERED) GMAS@35@ 
TN1(1) = ALPHA - BETA; TN2(2) = BETA; (NEUMANN-STAGGERED) GMAS@36¢ 
TN1(1) = RHO, RHO ARBITRARY; TN2(2) = ZETA, ZETA ARBITRARY, GMAS@37@ 
NONZERO; (MIXED). GMASG380 
BOTTOM BOUNDARY CONDITION : ONE OF GMASG39¢ 
TN1(N) = ALPHA; TN2(N) = BETA; (DIRICHLET) GMASG460 
TNI(N) = ALPHA; TN2(N) = SQRT(2) * BETA; (NEUMANN-CENTERED)GMAS@41¢ 
TNI(N) = ALPHA - BETA; TN2(N) = BETA; (NEUMANN-STAGGERED) GMAS@42@ 
TN1(N) = CHI, CHI ARBITRARY; TN2(N) = ETA, ETA ARBITRARY, GMAS@43¢ 
NONZERO; (MIXED). GMASG440 
NTYPE = 3; GENERAL SEPARABLE — PERIODIC BOUNDARY CONDITIONS .GMAS@45@ 
TN1(I) IS ARBITRARY, I = 1,2,...,N. GMASG469 
TN2(I) IS ARBITRARY, NONZERO, I = 1,2,...,N. GMAS@47¢ 
NIYPE = 4: CONSTANT COEFFICIENT - PERIODIC BOUNDARY GMAS@48¢ 
CONDITIONS. GMAS@49¢ 
TN1(I) = ALPHA, ALPHA ARBITRARY, I = 1,2,...,N. GMAS@50¢ 
TN2(L) = BETA, BETA ARBITRARY, NONZERO, I = 1,2,...,N. GMAS@51¢ 

IF N = 3, GMAS MAY RESPECIFY NTYPE. GMAS@52¢ 

TN1 IS AN ARRARY OF LENGTH N+1, DEFINED ABOVE. GMAS@53¢ 
TN2 IS AN ARRAY OF LENGTH N+1, DEFINED ABOVE. GMAS@54¢ 
M IS AN INTEGER, AS DEFINED ABOVE. M MUST BE GREATER THAN 2. GMASO55¢ 
MTYPE IS AN INTEGER DESCRIBING THE ARRAYS TMl AND TM2. GMAS@56¢ 
MTYPE = 1: GENERAL SEPARABLE - DIRICHLET, NEUMANN, OR GMAS@57¢ 
MIXED BOUNDARY CONDITIONS. GMAS@58¢ 
MTYPE = 2: CONSTANT COEFFICIENT - DIRICHLET, NEUMANN, GMASG59¢ 

OR MIXED BOUNDARY CONDITIONS. GMASG600 
MTYPE = 3: GENERAL SEPARABLE - PERIODIC BOUNDARY CONDITIONS .GMAS@61@ 
MIYPE = 4: CONSTANT COEFFICIENT - PERIODIC BOUNDARY GMAS@62¢ 
CONDITIONS. GMASG63¢ 
RESTRICTIONS ON TM1 AND TM2 ARE ANALOGOUS TO THOSE ON GMASG64¢ 

TN1 AND TN2, RESPECTIVELY, FOR EACH GIVEN TYPE. GMAS(65¢ 

IF M IS LESS THAN 6, GMAS MAY RESPECIFY MTYPE. GMAS@66¢ 

TM1 IS AN ARRAY OF LENGTH M+1, DEFINED ABOVE. GMAS@670 
TM2 IS AN ARRAY OF LENGTH M+l, DEFINED ABOVE. GMASG68¢ 
IBDIM IS THE ROW DIMENSION OF THE ARRAY B, AS IT APPEARS GMASG69¢ 
IN THE CALLING PROGRAM. GMAS@700 

B IS A TWO DIMENSIONAL ARRAY WITH AT LEAST M ROWS AND N GMAS@71@ 
COLUMNS. ON INPUT, B CONTAINS THE RIGHT HAND SIDE B(I,J) GMAS@72@ 

AS DEFINED ABOVE. ON OUTPUT, FROM A CALL TO GMAS WITH GMAS@730 
NPC = 1, B CONTAINS THE SOLUTION X(I,J), AS DEFINED ABOVE. GMAS@74¢ 

VN IS AN ARRAY OF LENGTH N+1. ON OUTPUT FROM A CALL TO GMAS GMAS@75¢ 
WITH NPC = @, VN CONTAINS THE EIGENVECTOR OF THE GMASO76¢ 
MATRIX TN CORRESPONDING TO THE ZERO EIGENVALUE. GMAS@77¢ 

VM IS AN ARRAY OF LENGTH M+1. ON OUTPUT FROM A CALL TO GMAS GMAS@78¢ 
WITH NPC = ¢, VM CONTAINS THE EIGENVECTOR OF THE GMAS79¢ 
MATRIX TM CORRESPONDING TO THE ZERO EIGENVALUE. GMASG800 

K IS THE MARCHING PARAMETER. MARCHING OCCURS IN THE GMASG81¢ 
N - DIRECTION. ON INPUT, IF K IS LESS THAN 2, IT GMASG82¢ 
ASSUMES THE DEFAULT VALUE K = 2. GMAS@83¢ 

R IS AN ARRAY OF LENGTH N * P + 3 * N + 2, WHERE P IS AN GMASG84¢ 
INTEGER GREATER THAN OR EQUAL TO LOG2( N / K ), AND K IS GMAS@85¢ 
GREATER THAN OR EQUAL TO 2. R CONTAINS OUTPUT FROM A GMAS@86¢ 


CALL TO GMAS WITH NPC = @. 


GMAS@87@ 
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A IS AN ARRAY OF LENGTH 5 * Q, WHERE Q = MAX( N+l, Mtl ). 
A IS USED AS A SCRATCHPAD ARRAY BY GMAS. 


NOTE THAT NPC, N, NIYPE, TN1, TN2, M, MTYPE, TMl, TM2 IBDIM, 
B, K, AND R ARE IDENTICAL TO THE CORRESPONDING PARAMETERS 
IN THE CALLING SEQUENCE FOR SUBROUTINE GMA. 
THE PARAMETERS VN, VM, AND A ARE DIFFERENT. 


GMAS CONTAINS ONE LABELED COMMON BLOCK, /MACHEP/, 
CONTAINING ON VARIABLE, TOL. TOL IS A MACHINE DEPENDENT 
CONSTANT EQUAL TO THE MACHINE EPSILON. IT IS INITIALIZED IN 
GMAS IN THE FIRST EXECUTABLE STATEMENT. 


A CALL TO GMAS WITH NPC = @ REPLACES A CALL TO GMA WITH 
NPC = @. 


A CALL TO GMAS WITH NPC = 1 REPLACES A CALL TO GMA WITH 
WITH NPC = 1. THE RIGHT HAND SIDE B IS PROJECTED INTO THE 
SUBSPACE ORTHOGONAL TO THE VECTOR V, WHERE V(I,J) = 
VM(I) * VN(J). THIS IS NECESSARY TO INSURE THAT THE LINEAR 
SYSTEM IS CONSISTENT. THE SOLUTION X IS ALSO PROJECTED INTO 
THE SUBSPACE ORTHOGONAL TO V. ALL OTHER SOLUTIONS CAN BE 
OBTAINED BY ADDING AN ARBITRARY SCALAR MULTIPLE OF V TO X. 


ADDRESS INQUIRIES TO: 
RANDOLPH E. BANK 
DEPARTMENT OF MATHEMATICS 
THE UNIVERSITY OF CHICAGO 
CHICAGO, ILLINOIS 69637 


VERSION DATE: MARCH 1, 1977. 
DIMENSION TN1(1),TN2(1),TM1(1),7M2(1) 
DIMENSION VN(1),VM(1),A(1),B(1),R(1) 
COMMON /MACHEP/TOL 

TOL=2 . GEG** (~23) 

CHECK N, NTYPE, M, MTYPE, AND IBDIM. 

IF((NTYPE.GT.4) .OR. (NTYPE.LT.1)) RETURN 

IF ((MIYPE.GT.4).OR.(MTYPE.LT.1)) RETURN 

IF((N.LT.2).OR.(M.LT.2)) RETURN 

IF(IBDIM.LT.M) RETURN 

RESPECIFY NTYPE AND/OR MTYPE IF NECESSARY. 

IF(NTYPE.EQ.2.AND.N.LE.3) NTYPE=1 

IF (MTYPE.EQ.2.AND.M.LE.3) MTYPE=1 

IF (NTYPE.EQ.4.AND.N.LE.3) NTYPE=3 

IF (MTYPE.EQ.4.AND.M.LE.5) MTYPE=3 

IF(N.LE.2) NTYPE=1 

IF(M.LE.2) MTYPE=1 

IF(NPC.NE.@) GO TO 15 

THE PREPROCESSING CALCULATIONS. 

KK=MIN@ (K,N) 

CALL PARTN(N,NTYPE,KK,NE,ND,R(3)) 

EPS IS ADDED TO ALL INTEGERS STORED IN THE REAL ARRAY R. 

THIS PREVENTS UNFORTUNATE ROUNDING ERRORS FORM OCCURRING WHEN 

THEY ARE CONVERTED BACK INTO INTEGERS. 

EPS=@.25E@ 

R(1)=FLOAT (NE)+EPS 

R(2)=FLOAT (ND)+EPS 

IF (NTYPE.EQ.1.OR.NTYPE.EQ.3) CALL ROOTSG(N,NTYPE, 
TN1,TN2,NE,ND,R(3) ,R(N+3) ,A) 

IF (NTYPE.EQ.2.OR.NTYPE.EQ.4) CALL ROOTSC(N,NTYPE, 
TN1,TN2,NE,ND,R(3) ,R(N+3) ,A) 

CALL SVALUE(N,NIYPE,M,MTYPE,TM1,TM2,NE,R(N+3) , TMIN) 

J1=N+2 

J2=J1+N+1 

CALL SORT(N,NTYPE,NE,ND,R(3),R(N+3) ,A(1) ,A(J1) ,A(J2)) 

J=MAX@(N,M)+1 

Jl=J+1 

J2=J1+J 

J3=J2+J 

J4=JI3+J 

IF(NTYPE.LT.3) CALL TINVIT(N,TN1,TN2,TMIN,VN, 
A(1) ,A(J1) ,A(J2) ,A(J3) , IFLAG) 

IF(NTYPE.GE.3) CALL PINVIT(N,TN1,TN2,TMIN,VN, 
A(1) ,A(J1) ,A(J2) ,A(J3) ,A(J4) , IFLAG) 

TMIN=—TMIN 

IF(MTYPE.LT.3) CALL TINVIT(M,TM1,TM2,TMIN, VM, 


GMAS@88¢@ 
GMAS@89@ 
GMASO96¢ 
GMASG91@ 
GMAS@92@ 
GMASO6930 
GMAS@940 
GMASO95@ 
GMAS@960 
GMASG97@ 
GMASG98@ 
GMASG990 
GMAS1¢0@ 
GMAS1919 
GMAS1962@ 


GMAS193@ 
GMAS194¢ 


GMAS1065@ 
GMAS196@ 
GMAS107¢@ 
GMAS1068@ 
GMAS199¢ 
GMAS11¢6¢ 
GMAS111@ 
GMAS112@ 
GMAS113@ 
GMAS114@ 
GMAS115@ 
GMAS116@ 
GMAS117@ 
GMAS118@ 
GMAS119¢ 
GMAS12¢@ 
GMAS1219 
GMAS122¢ 
GMAS123@ 
GMAS124@ 
GMAS125@ 
GMAS126@ 
GMAS127@ 
GMAS128@ 
GMAS129¢@ 
GMAS13¢@ 
GMAS131@ 
GMAS132@ 
GMAS133@ 
GMAS134@ 
GMAS135@ 
GMAS136@ 
GMAS137¢@ 
GMAS1380@ 
GMAS139@ 
GMAS146¢ 
GMAS141@ 
GMAS1426 
GMAS143@ 
GMAS144@ 
GMAS145@ 
GMAS146@ 
GMAS147@ 
GMAS148¢ 
GMAS149@ 
GMAS15¢¢ 
GMAS151¢ 
GMAS152¢ 
GMAS153@ 
GMAS154@ 
GMAS155@ 
GMAS156@ 
GMAS157@ 
GMAS158¢@ 
GMAS159¢ 
GMAS160¢ 
GMAS161@ 
GMAS162@ 
GMAS163@ 
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15 


1 
1 


A(1) ,A(J1) ,A(J2) ,A(J3) , IFLAG) 

IF (MTYPE.GE.3) CALL PINVIT(M,TM1,1TM2,TMIN,VM, 
A(L),A(J1) ,A(J2) ,A(J3) ,A(J4) , [FLAG) 

RETURN 

THE BACKSOLUTION CALCULATIONS. 

TN2 (N+1)=1.QEQ 

IF (NTYPE.LT.3) TN2(1)=1.E@ 

NE=R (1) 

ND=R (2) 

CALL PROJ(1,N,NTYPE,VN,M, VM, IBDIM,B,NE,ND,R(3) , COEFF) 

CALL STEP1(N,NTYPE,TN1,IN2,M,MTYPE,TM1,1M2, 
IBDIM,B,ND,R(3) ,R(N+3) ,A) 

CALL PROJ(2,N,NTYPE,VN,M,VM, IBDIM,B,NE,ND,R(3) , COEFF) 

CALL STEP2(N,NTYPE,TN2,M,MTYPE,TM1,1TM2, 
IBDIM,B,NE,ND,R(3) ,R(N+3),A) 

CALL PROJ(3,N,NTYPE,VN,M,VM, IBDIM,B,NE,ND,R(3) ,COEFF) 

CALL STEP3(N,NTYPE,TN2,M,MTYPE,TM1 ,1M2, 
IBDIM,B,NE,ND,R(3) ,R(N+3) ,A) 

CALL STEP4(TN1,TN2,M,MTYPE,TM1 ,TM2,IBDIM,B,ND,R(3) ,R(N+3) ,A) 

CALL PROJ(1,N,NTYPE,VN,M,VM, IBDIM,B,NE,ND,R(3) ,COEFF) 

RETURN 

END 


SUBROUTINE SVALUE(N,NTYPE,M,MTYPE,TM1 ,TM2,NE,R,TMIN) 
SUBROUTINE SVALUE DETERMINES TMIN, THE ROOT ASSOCIATED 
WITH THE ZERO EIGENVALUE. THIS ROOT IS PERTURBED TO PREVENT 
POSSIBLE DIVIDE CHECKS DURING THE BACKSOLUTION PROCESS. 
VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION TM1(1),T™2(1),R(1) 
COMMON /MACHEP/TOL 
IF (MTYPE.LT.3) TM2(1)=@.@E@ 
TM2 (M+1)=TM2 (1) 
T=. GEO 
Q=ABS (TM2(1)) 
DO 5 I=1,M 
S=Q 
Q=@ABS (TM2 (I+1) ) 
T=AMAX1 (T, ABS (TMI (I) )+Q+S) 
CONTINUE 
L=N*NE 
IF (NTYPE.GE.3) L=L+N 
JMIN=L+1 
IF ((TM1(1)+R(JMIN)).LT.@.GE@) T=-T 
L=L4+N 
IF (ABS (T+R(JMIN) ) .GT.ABS(T+R(L))) JMIN=L 
TMIN=R (JMIN) 
R(JMIN) = IMIN+ (T+TMIN) * FLOAT (M) * TOL 
RETURN 
END 


SUBROUTINE TINVIT(N,D,E,EIGEN,V,A,B,C,F, IFLAG) 
SUBROUTINE TINVIT COMPUTES THE EIGENVECTOR OF A 
SYMMETRIC TRIDIAGONAL MATRIX CORRESPONDING TO THE EIGENVALUE 
EIGEN. INVERSE ITERATION AND GAUSSIAN ELIMINATION WITH 
PARTIAL PIVOTING IS EMPLOYED. D AND E CONTAIN THE 
TRIDIAGONAL MATRIX. A, B, AND C CONTAIN THE UPPER TRIANGULAR 
MATRIX. F CONTAINS THE LOWER TRIANGULAR MATRIX. 
V CONTAINS THE EIGENVECTOR. 
VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION A(1),B(1),C(1),D(1),E(1),F(1),V(1) 
COMMON /MACHEP/TOL 
IFLAG=6 
Q=ABS (D(1)) 
DO 5 I=2,N 
Q=Q+ABS (D (I) )+ABS (E(I)) 
EPS=TOL*Q*FLOAT (N) 
Z=TOL*Q*SQRT (FLOAT (N) ) 
E(N+1)=0.GE@ 
R=E (2) 
U=D (1) -EIGEN 
V(1)=Z 
DO 15 I=2,N 
IMl=I-1 
V(I)=z 


GMAS164@ 
GMAS165¢@ 
GMAS166¢ 
GMAS16/@ 
GMAS168¢ 
GMAS169¢@ 
GMAS1706@ 
GMAS1710@ 
GMAS172@ 
GMAS173@ 
GMAS174@ 
GMAS175@ 
GMAS176@ 
GMAS177¢@ 
GMAS178@ 
GMAS179@ 
GMAS18¢@ 
GMAS181¢ 
GMAS182@ 
GMAS183@ 
GMAS184@ 
GMAS185@ 


SVALGG10 
SVALOO2¢ 
SVALO4O3¢ 
SVALOG4O 
SVALOG5@ 
SVALOG6G 
SVALGQ7¢ 
SVALOO8G 
SVALOGIG 
SVALO16¢@ 
SVALO11¢ 
SVALO12¢ 
SVALG13¢ 
SVAL@14@ 
SVAL@15¢ 
SVALO16@ 
SVALO17@ 
SVALO18@ 
SVALG19¢ 
SVAL@200 
SVALG210 
SVALG22¢ 
SVALG236 
SVALO246 
SVAL@25@ 
SVAL@260 


TINVOO1O 
TINVGG2G 
TINVGO3¢ 
TINVOG4O 
TINVOG5O 
TINVOG6O 
TINVGO7¢ 
TINVGO8G 
TINVOGIG 
TINVO1OO 
TINVO11¢ 
TINVG12¢ 
TINVO13¢ 
TINVO1L4O 
TINVG15¢ 
TINVG16¢ 
TINVG17¢6 
TINVO18@ 
TINVG19¢ 
TINVO2060 
TINV@219 
TINVO22¢ 
TINVO23¢ 
TINVO24G 
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16 


15 


25 


3¢ 


4g 


45 
5¢ 


6¢ 
65 


7¢ 


IF (ABS (E(I)) .GT.ABS(U)) GO TO 1¢ 


Q=E(I)/U 
F(I)=Q 
A(IM1)=U 
B(IM1)=R 
C(IM1)=@.GE@ 
U=D (1) -EIGEN-Q*R 
R=E(I+1) 
GO TO 15 
Q=U/E(1) 
F(I)=Q 
ACIML)=~E (I) 
B(IM1)=EIGEN-D (1) 
C(IM1)#E(I+1) 
U=—R-Q*B (IM1) 
R=Q*C (IML) 
CONTINUE 
IF(U.EQ.0@.@E@) U=EPS/FLOAT(N) 
A(N)=U 
B(N)=@.GE@ 
C(N)=06.GE@ 
L=1 
DO 5¢@ J=1,5 
DO 25 I=2,N 
IMl=I-1 
Q=V (I) 
R=-E (I) 
IF(A(IM1).NE.R) GO TO 25 
Q=V (IM1) 
V(IM1)=V (1) 
V(1)=Q+F (1) *V (IML) 
Q=¢.GEO 
R=@.GEO 
Z=0.GEO 
DO 3¢ II=1,N 
I=N+1-I1 


V(1)=(V (1) +Q*B(1)+R*C(1)) /A(T) 


R=Q 
Q=V (I) 

_ Z=Z-+ABS(Q) 
IF(Z.GT.1.¢E@) GO TO 60 
IF(Z.NE.@.GE@) GO TO 4@ 
V(L)=EPS 
LeL+1 
IF(L.GT.N) Lal 
GO TO 5¢ 
Z=EPS/Z 
DO 45 I=1,N 

V(I)=V(I)*Z 
CONTINUE 
IFLAG=1 
Z=6. GEO 
DO 65 I=1,N 
Z=Z+V (1)*V (I) 
Z=1.GE@/SQRT(Z) 


SUBROUTINE PINVIT(N,D,E,EIGEN,V,A,B,C,F,G, IFLAG) 

SUBROUTINE PINVIT COMPUTES THE EIGENVECTOR OF A 
SYMMETRIC MATRIX ASSOCIATED WITH PERIODIC BOUNDARY CONDITIONS, 
CORRESPONDING THE THE EIGENVALUE EIGEN. 
AND GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING ARE EMPLOYED. 
D AND E CONTAIN THE MATRIX WITH PERIODIC BOUNDARY CONDITIONS. 
A, B, C, AND G CONTAIN THE UPPER TRIANGULAR MATRIX. 
F CONTAINS THE LOWER TRIANGULAR MATRIX. 


EIGENVECTOR. 
VERSION DATE: FEBRUARY 1, 1977. 


DIMENSION A(1),B(1),C(1),D(1),E(1),F(1),G(1),V(1) 


COMMON /MACHEP/TOL 
IFLAG=@ 
NMl=N-1 
Q=0.GEO 


INVERSE ITERATION 


V CONTAINS THE 


TINVO25¢ 
TINVG26@ 
TINVG27@ 
TINVG28@ 
TINVG29¢ 
TINVG3@0 
TINVG31¢ 
TINVG320 
TINVO33@ 
TINVG34@ 
TINVO35¢ 
TINVO36@ 
TINVO37@ 
TINV@38@ 
TINVO390 
TINVG4G¢ 
TINVO410 
TINVG420 
TINVG43@ 
TINVG446 
TINVO45¢ 
TINVO469 
TINVO470 
TINVG48@ 
TINVG490 
TINVO5G0O 
TINVG51@ 
TINV@52¢ 
TINVG53@ 
TINVO54@ 
TINVO55¢ 
TINVG56@ 
TINVG576 
TINVO58¢ 
TINVG599 
TINVG6GO 
TINVG61¢ 
TINVG620 
TINVG63@ 
TINVO64G 
TINVG65¢ 
TINVG66@ 
TINVO67@ 
TINVG68¢ 
TINVG69¢@ 
TINVG740 
TINVO71@ 
TINV@7 20 
TINVO730 
TINVG74@ 
TINVG75@ 
TINVG76@ 
TINVO77@ 
TINVO78@ 
TINVG79@ 
TINVG8EO 
TINVG81¢ 
TINVG826 
TINVG83¢ 


PINVOG1O 
PINVGG2@ 
PINVOO3¢ 
PINVGG4O 
PINVG@5@ 
PINVOG6O 
PINVGO7@ 
PINVGO8O 
PINVGG9@ 
PINVO1606 
PINVG119 
PINVG12@ 
PINVG13¢ 
PINVQG14@ 
PINVG15@ 
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15 


26 


25 


3¢ 


35 


DO 5 I=1,N 
G(I)=¢.¢E¢ 
Q=Q+ABS (D (I) )+ABS(E(I)) 
EPS=TOL*Q* FLOAT (N) 
Z=TOL*Q*SQRT (FLOAT (N) ) 
R=E (2) 
U=D (1) -EIGEN 
V(1)=Z 
V(N)=Z 
G(1)=E(1) 
G(NM1)=E(N) 
DO 15 I=2,NM1 
IM1=I-1 
V(I)=2Z 
IF (ABS(E(1)).GT.ABS(U)) GO TO 1¢ 
Q=E(I) /U 
F(I)=Q 
ACIM1)=U 
B(IM1)=R 
C(IM1)=¢.¢E@ 
=D (1) -EIGEN-Q*R 
R=E(I+1) 
G(1)=G (1)+Q*G (IM1) 
GO TO 15 
Q=U/E(I) 
F(I)=Q 
A(IM1)=-E (1) 
B(IM1)=EIGEN~D (I) 
C(IM1)=E (I+1) 
U=-R-Q*B (IML) 
R=G(IM1) 
G(IM1)=G(TI) 
G(I)=R+Q*G (IML) 
R=Q*C (IML) 
CONTINUE 
IF (U.EQ.@.GE@) U=EPS/FLOAT(N) 
A(NM1) =U 
B(NM1)=@.0E@ 
C(NM1)=@.(E@ 
C(N-2)=@.9E@ 
Q=¢.G0EO 
R=¢.QEO 
DO 2@ II=1,NM1 
I=N-IT 
G(1)=(G(1)+Q*B (I)+R*C (1)) /A(T) 
R=Q 


Q=G(I) 
U=D (N) -EIGEN-E (1)*G(1)-E(N)*G(NM1) 
IF(U.EQ.@.GE@) UsEPS/FLOAT(N) 


A(N)=U 
L=1 
DO 5@ J=1,5 
DO 25 I=2,NM1 
IMl=I-1 
Q=V (I) 
R=-E (I) 
LF(ACIML) .NE.R) GO TO 25 
Q=V (IM1) 
V(IM1)=V (I) 
V(1)=Q+F (I) *V (IM1) 
Q=0. GEO 
R=. GEO 
DO 3 IIl=1,NM1 
I=N-LI 


V(1)=(V (L)4+Q*B (I) +R*C (I) ) /A(T) 
R= 


) 

Q= (V (N)-+E (1) *V(1)+E (N)*V (NM) ) /A(N) 
V(N)=Q 
Z=ABS (Q) 
DO 35 I=1,NM1 

V(I)=V(1)+G6(T)*Q 

Z=Z+ABS (V (I) ) 
IF(Z.GT.1.GE@) GO TO 6¢ 
IF(Z.NE.6.GE@) GO TO 40 
V(L)=EPS 


PINVG16¢6 
PINV@17@ 
PINVG18¢ 
PINVG190 
PINVG260 
PINVG210 
PINVG220 
PINV@23@ 
PINVG24@ 
PINV@25@ 
PINV@26@ 
PINV@27@ 
PINVO28¢ 
PINVG29@ 
PINVO300 
PINVG31¢ 
PINVO32¢ 
PINVG33@ 
PINVG340 
PINV@35@ 
PINVG36@ 
PINVO37@ 
PINVG38@ 
PINVO39@ 
PINVO4G¢ 
PINVG41@ 
PINVG42¢ 
PINVG43@ 
PINVOG44@ 
PINV@45@ 
PINVG46@ 
PINVG47@ 
PINVO48@ 
PINVG49O 
PINVG506¢ 
PINV®510 
PINVO520 
PINVO53@ 
PINVO54@ 
PINVG55@ 
PINVG56@ 
PINVO57@ 
PINVO58@ 
PINVG59@ 
PINVG600 
PINVG61@ 
PINVG626 
PINV630 
PINVG64¢ 
PINV@65@ 
PINVG66¢ 
PINVG67@ 
PINV@68@ 
PINVG69@ 
PINVG70¢ 
PINVG710 
PINV@72@ 
PINVO73@ 
PINVG740@ 
PINVO75¢ 
PINVO76@ 
PINVO77@ 
PINVO78@ 
PINVQ79@ 
PINVG8OO 
PINVG81¢ 
PINVG8 26 
PINVG83@ 
PINVG84¢@ 
PINV@85@ 
PINVG86@ 
PINVO87@ 
PINVG88¢ 
PINVG89@ 
PINVO9GO 
PINVOI16 
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1¢ 
15 


2¢ 
25 


3¢ 


35 
49 


45 
50 


55 


60 


LeLt+l 
IF(L.GT.N) Le=1 
GO TO 5¢ 
Z=EPS/Z 
DO 45 I=1,N 
V(I)=V (1) *zZ 

CONTINUE 

IFLAG=1 

Z=. GEO 

DO 65 I=1,N 
Z=Z+V (1) *V(I) 

Z2=1.0E@/SQRT(Z) 

DO 7¢ I=1,N 
V(I)=V (1) *z 

RETURN 

END 


SUBROUTINE PROJ (ITYPE,N ,NTYPE,VN,M,VM, IBDIM,B,NE,ND, ID COEFF) 
SUBROUTINE PROJ COMPUTES THE PROJECTIONS NECESSARY TO 
INSURE THAT THE LINEAR SYSTEM IS CONSISTENT. 
VERSION DATE: FEBRUARY 1, 1977. 
REAL ID 
DIMENSION VN(1),VM(1),B(1),ID(1) 
COEFF=(@.9E@ 
GO TO (5,34,55) ,ITYPE 
DO 15 I=1,N 
T=%.0E@ 
LNPTR=(I-1)*IBDIM 
D 


O 1¢ J=1,M 
LNPTR=LNPTR+1 
T=T+VM(J)*B(LNPTR) 

COEFF=COEFF+VN (1) *T 

DO 25 I=1,N 

T=COEFF*VN (I) 

LNPTR= (I-1)*IBDIM 

DO 26 J=1,M 
LNPTR=LNPTR+1 
B(LNPTR)#=B (LNPTR) -T*VM(J) 

CONTINUE 

RETURN 

NN=ND 

IF(NTYPE.GE.3) NN=ND+1 

ID2=ID (2) 

IF ((NN.LE.1).OR.(ID2.EQ.2)) RETURN 
Q= . GE 

DO 46 I=1,NN 

LINE=ID (I+1) 

T= GEO 

LNPTR=(LINE-1)*IBDIM 

DO 35 J=1,M 
LNPTR=LNPTR+1 
T=T+VM(J)*B(LNPTR) 

Q=Q+VN (LINE) *VN (LINE) 

COEFF=COEFF+VN (LINE) *T 

COEFF=COEFF/Q 
DO 5@ I=1,NN 

LINE=ID (I+1) 

T=COEFF*VN (LINE) 

LNPTR= (LINE-1)*IBDIM 

DO 45 J=1,M 
LNPTR=LNPTR+1 
B(LNPTR)=B (LNPTR) -T*VM(J) 

CONTINUE 

RETURN 

NN=NE-1 

IF (NTYPE.GE.3) NN=NE 

IF (NN.LT.@) RETURN 

I=2**NN+L 

I=ID (I) 

LNPTR= (I-1)*IBDIM 

DO 60 J=1,M 
LNPTR=LNPTR+1 
COEFF=COEFF+VM(J)*B(LNPTR) 

LNPTR= (I-1)*IBDIM 


PINVG920 
PINVG93¢ 
PINVG94¢ 
PINVO950 
PINVG96G 
PINVG97¢ 
PINVG98O 
PINVO990 
PINV1OG¢ 
PINV1G1¢ 
PINV1¢2¢ 
PINV1G3@ 
PINV104@ 
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PINV1O7@ 
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PROJQ11¢ 
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PROJG16¢ 
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PROJG21¢ 
PROJO220 
PROJG230 
PROJG240 
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PROJO260 
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PROJG330 
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PROJO43¢ 
PROJG44@ 
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DO 65 J=1,™M 
LNPTR=LNPTR+1 
B(LNPTR)=B (LNPTR) -COEFF*VM (J) 
RETURN 
END 


SUBROUTINE EIGEN(N,NTYPE,D,E,K,EIG) 

SUBROUTINE EIGEN COMPUTES THE K TH EIGENVALUE FOR 
MATRICES OF THE TYPE ALLOWED BY SUBROUTINE GMA. 
VERSION DATE: FEBRUARY 1, 1977. 

DIMENSION D(1),E(1) 
PI=3.1415926535897932384626433832795E@ 
E(N+1)=E (N) 

IF(NTYPE.LT.3) E(1)=E(2) 

GO TO (16,15,50,60) ,NIYPE 

CALL TRIEIG(N,D,E,K,EIG) 

RETURN 

IF(N.LE.3) GO TO 19 

I=15 

T1=D (2) 

T2=E (3) 

$2=SQRT(2.Q@EG)*T2 

Ql=D (1) 

Q2=E (2) 

IF (Q1.EQ.T1.AND.Q2.EQ.T2) I=I-7 
IF(Q1.EQ.T1.AND.Q2.EQ.S2) I=I-6 
IF(Q1.EQ. (T1-T2) .AND.Q2.EQ.T2) I=I-4 

Ql=D (N) 

Q2=E (N) 

IF(Q1.EQ.T1.AND.Q2.EQ.T2) I=I-7 
IF(Q1.EQ.T1.AND.Q2.EQ.S2) I=I-6 
IF(QL.EQ. (T1-T2) .AND.Q2.EQ.T2) I=I-4 
IF(I.GT.7) GO TO 1¢ 

GO TO (20,25,3¢,35,44,16,45),1 
EIG=T1-T2*2.@EG@*COS (FLOAT (K) *PL/FLOAT (N+1) ) 
RETURN 
EIG=T1-T2*2.@E@*COS.“FLOAT (2*K-1) *P1/FLOAT (2*N) ) 
RETURN 

EIG=T1-T2*2 .@E@*COS (FLOAT (K-1) *PI/FLOAT (N-1) ) 
RETURN 
EIG=T1-T2*2.@EO*COS (FLOAT (2*K-1)*P1/FLOAT (2*N+1) ) 
RETURN 

EIG=T1-T2*2 .GEQ@*COS (FLOAT (2* (K-1) )*PI/FLOAT (2*N-1) ) 
RETURN 
EIG=T1-T2*2..@EG*COS (FLOAT (K-1)*PI/FLOAT (N) ) 
RETURN 

CALL PEREIG(N,D,E,K,EIG) 

RETURN 

I=(K/2)*2 

EIG=D (1)-E(3)*2.Q@E@*COS (FLOAT (1) *PI/FLOAT (N) ) 
RETURN 

END 


SUBROUTINE ERROR (EMARCH, BIG, TMMAX,N,TN1,TN2,K,ND) 
SUBROUTINE ERROR PARTITIONS THE LINEAR SYSTEM USING THE 
SAME ALGORITHM AS SUBROUTINE GMA. EMARCH IS DETERMINED BY 


USING A ONE DIMENSIONAL MARCH WITH THE SCALAR TMMAX PLAYING THE 


ROLE OF THE MATRIX TM. 
VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION TN1(1),TN2(1) 
EMARCH=@.@E@ 
ND=N/MAX@ (2,K) 
IF (ND*2.EQ.N) ND=ND-1 
NDP1=ND+1 
I1=N/NDP1 
I2=N-L1L*NDP1 
13=¢ 
ID=¢ 
DO 65 LNINDX=1,NDP1 
LINE=ID+1 
IF(I3.LT.12) 13=13+1 
ID=I 1*LNINDX+13 
IF(LNINDX.EQ.NDP1) ID=N+1 
ISPAN=ID-1 
Rl=1.@E@ 
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PROJG61¢ 
PROJG62¢ 
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EIGN@31@ 
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EIGN@380 
EIGN@390 
EIGNO4G@ 
EIGN@416 
EIGN@42¢ 
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EIGN@44@ 
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EIGN@46@ 
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ERORGO4¢ 
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EROROG60 
EROROO7@ 
EROROO80 
EROROO9G 
ERORG10@ 
EROR@11¢ 
EROR@120 
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EROR@14@ 
EROR@15@ 
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ERORG196 
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R2=@. GEO 
DO 55 J=LINE, ISPAN 
LF(ABS(R1).GT.BIG) GO TO 10¢ 
T= ( (TMMAX+TN1 (J) )*R1-TN2(J)*R2) /TN2(J+1) 
R2=R1 
Rl=T 
R1=ABS (R1) 
R2=ABS (TN2 (ID) /TN2 (LINE) )*R1 
T=AMAX1 (R1,R2) 
EMARCH=AMAX1 (‘T , EMARCH) 
CONTINUE 
RETURN 
EMARCH=BIG 
RETURN 
END 


SUBROUTINE TRIEIG(N,D,E,K, EIGEN) 
SUBROUTINE TRIEIG COMPUTES THE K TH-EIGENVALUE OF AN 

IRREDUCIBLE SYMMETRIC TRIDIAGONAL MATRIX USING BISECTION 

AND THE STURM SEQUENCE anger INITIAL UPPER AND LOWER 

BOUNDS ARE DETERMINED FROM GERSCHGORIN ESTIMATES. 

VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION D(1);E(1) 
COMMON /MACHEP/TOL 

E(N+1)=@.G6E@ 

T=@.@E@ 

XU=D (1) 

XL=D (1) 

DO 5 I=1,N 
X=T 
T#ABS (E(I+1) ) 
XU=@AMAX1 (XU ,D (1)+(X+T) ) 
XL=AMINI (XL,D(1)-(X+T) ) 

EPS=AMAX1 (ABS (XU) , ABS (XL) )* TOL 

XU=XU+EPS 

XL=XL-EPS 

E(N+1)=E(N) 

E(1)=¢.GE@ 

X= (XL+XU) /2.GE@ 

T=EPS+4 . GEQ* TOL* (ABS (XL)+ABS (XU) ) 

IF((XU-XL).LE.T) GO TO 5¢ 

KCOUNT#=@ 

T=1.0E0 

DO 2¢ I=1,N 
IF(T.EQ.@.@E@) T=TOL*ABS (E(I) ) 
T=D (I) -X-E(1I)*E(1I)/T 
IF(T.LT.@.@E@) KCOUNT=KCOUNT+1 
CONTINUE 

IF(KCOUNT-K) 30@,35,35 

XL#=X 

GO TO 1¢ 

XU=X 

GO TO 1¢ 

EIGEN=X 

E(1)=E(2) 

RETURN 

END 


SUBROUTINE PEREIG(N,D,E,K, EIGEN) 

SUBROUTINE PEREIG COMPUTES THE K TH EIGENVALUE OF THE 
IRREDUCIBLE SYMMETRIC MATRIX WHICH ARISES IN THE CASE OF 
PERIODIC BOUNDARY CONDITIONS. BISECTION AND THE STURM 
SEQUENCE PROPERTY ARE USED. INITIAL UPPER AND LOWER BOUNDS 
ARE DETERMINED FROM GERSCHGORIN ESTIMATES. 

VERSION DATE: FEBRUARY 1, 1977. 

DIMENSION D(1),E(1) 

COMMON /MACHEP/TOL 
E(N+1)=E(1) 

NM1=N-1 
T=ABS (E(1)) 
XU=D (1) 
XL=D (1) 
DO 5 I=1,N 
X=T 
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T=ABS (E(I+1) ) 
XU=AMAX1 (XU ,D (1)+(X+T) ) 
XL=AMIN1 (XL,D(I)—(X+T) ) 
EPS=AMAX1 (ABS (XU) , ABS (XL) ) 
EPS1=1.E-2*EPS 
EPS=EPS*TOL 
XU=XU+EPS 
XL=XL-EPS 
X= (XL+XU) /2.GE@ 
T=EPS+4 . PEQ*TOL* (ABS (XL) +ABS (XU) ) 
LF ((XU-XL) .LE.T) GO TO 6¢@ 
KCOUNT=@ 
ITEST=@ 
Q=D (1)-X 
T=E (1) 
C=D (N)-X 
IF(Q.LT.@.@E@) KCOUNT#=1 
DO 3¢ I=2,NM1 
Ql=Q 
Tl=T 
IF(Q1.EQ.@.GEG) Ql=TOL*ABS(E(I)) 
V=E(I)/Q1 
=D (1) -X-E(1)*V 
T=T1*V 
IF(Q.LT.@.@E@) KCOUNT=KCOUNT+1 
IF(ITEST.EQ.1) GO TO 25 
IF(T1+C.EQ.C) GO TO 3¢ 
IF(ABS(Q1).LE.EPS1) GO TO 2¢ 
C=C-T1*T1/Q1 
GO TO 3¢ 
C=C-T1*T1* (D(1)-X) /(Q1*Q) 
ITEST=1 
GO TO 3¢ 
ITEST=0 
CONTINUE 
IF(Q.EQ.@.@E@) Q=TOL*ABS (E(N) ) 
IF (ITEST) 35,35,4¢ 
Q=C-(E(N)+T)* ((E(N)+T) /Q) 
GO TO 45 
Q=C-E(N)* ((E(N)+2 .GE@*T) /Q) 
IF(Q.LT.@.@E@) KCOUNT=KCOUNT+1 
IF (KCOUNT-K) 5@6,55,55 
XL=X 
GO TO 1¢ 
XU=X 
GO TO 1¢ 
EIGEN=X 
RETURN 
END 


PROGRAM DRIVER 


THIS DRIVER GENERATES RANDOM PROBLEMS TO TEST SUBROUTINES 


KPICK, GMA, AND GMAS. 


THE USER MAY SPECIFY THE FOLLOWING PARAMETERS, WHICH APPEAR 


AS THE FIRST FIVE EXECUTABLE STATEMENTS: 


ITMAX = THE NUMBER OF RANDOM PROBLEMS TO BE SOLVED. 
= THE MAXIMUM VALUE OF N ALLOWED. 

MMAX = THE MAXIMUM VALUE OF M ALLOWED. 

IBDIM = THE ROW DIMENSION OF THE ARRAY B. 

TOL = THE MACHINE EPSILON. 


MINIMUM DIMENSIONS FOR THE ARRAYS ARE AS FOLLOWS: 
A: 5 * MAX( NMAX+1, MMAX+1 ) 

B: MMAX +2 X  NMAX + 2 

R: NMAX * INT( LOG2( NMAX ) ) + 3 * NMAX + 2 

TN1, TN2, VN: NMAX + 1 

TM1, TM2, VM: MMAX + 1 


THE PROGRAM IS COMPLETE EXCEPT FOR THE TIMER, WHICH IS 
REFERRED TO AS THE INTEGER FORTRAN FUNCTION ITIMER(I). 


VERSION DATE: MARCH 1, 1977. 
COMMON /RANI/INIT,IINIT, ISAVE 
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PEIGO500 
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COMMON /MACHEP/TOL 
DIMENSION A(16@) ,B(33,33) ,R(226) 
DIMENSION TN1(32),TN2(32),VN(32) ,TM1 (32) ,TM2 (32) ,VM(32) 
LTMAX=149 
NMAX=31 
MMAX=31 
IBD IM=33 
TOL=2. GEQ** (-23) 
INIT=1367 
LINIT=INIT 
D1=-ALOG1@(TOL)-1.GE@ 
DO 2@ I=1,ITMAX 
N=INTRAN (3, NMAX) 
M=INTRAN (3,MMAX) 
NTYPE=INTRAN (1,4) 
MTYPE=INTRAN(1,4) 
ITYPE=@ 
JTYPE=@ 
IF(NTYPE.EQ.2) ITYPE=INTRAN(1,9) 
IF(MTYPE.EQ.2) JTYPE=INTRAN(1,9) 
IDEF=INTRAN (@, 3) 
DEMAND=RAN (1 .@E@,D1) 
CALL TEVAL(N,NTYPE, ITYPE,TN1,TN2,IDEF) 
CALL TEVAL(M,MTYPE, JTYPE,TM1 ,TM2,IDEF) 
ITK=ITIMER (@) 
CALL KPICK(@,N,NTYPE,TN1,TN2,M,MTYPE,TM1 ,TM2, 
DEMAND ,K, COND , EMARCH, DIGITS, LFLAG) 
ITK=ITIMER (6) -ITK 
IF(IDEF.GT.1) GO TO 5 
ITR=ITIMER (0) 
CALL GMA(@,N,NTYPE,TN1,TN2,M,MTYPE,TM1,TM2,IBDIM,B, 
K,R,A) 
ITR=ITIMER(Q@)-ITR 
CALL RHS(N,NTYPE,TN1,TN2,M,MTYPE,TM1,TM2,IBDIM,B, 
IDEF , VN, VM, COEFF) 
ITS=ITIMER () 
CALL GMA(1,N,NTYPE,TN1,TN2,M,MTYPE,TM1,TM2,IBDIM,B, 
K,R,A) 
ITS=ITIMER(@)-ITS 
GO TO 10 
ITR=ITIMER (@) 
CALL GMAS(@,N,NTYPE,TN1,TN2,M,MTYPE,TM1,TM2,IBDIM,B, 
VN,VM,K,R,A) 
ITR=ITIMER(@)-ITR 
CALL RHS(N,NTYPE,TN1,TN2,M,MTYPE,1TM1,TM2,IBDIM,B, 
IDEF, VN, VM, COEFF) 
ITS=ITIMER () 
CALL GMAS(1,N,NTYPE,TN1,TN2,M,MTYPE,TM1 ,TM2,IBDIM,B, 
VN,VM,K,R,A) 
ITS=ITIMER(@)-ITS 
LTG=ITR+ITS 
CALL NORM(ACTUAL,N,M, I[BDIM,B, IDEF,VN,VM,COEFF) 
IF (MOD(1,50) .EQ.1) WRITE(6,50) 
WRITE(6,55) I,N,NTYPE,ITYPE,M,MTYPE, JIYPE,K, IFLAG, IDEF, 
COND , EMARCH ,DEMAND ,DIGITS ,ACTUAL,ITK, ITG, ITR, ITS 
CONTINUE 
FORMAT(1LH1 / 46X,34HTHE GENERALIZED MARCHING ALGORITHM // 
14X,18HPROBLEM PARAMETERS, 17X,6HERRORS,13X,14HCORRECT DIGITS, 


21X,7HTIMINGS / 4X,36HI N NTVYPE M MTYPE K ‘DEF, 5X, 
4Q@HCOND EMARCH DEMAND DIGITS ACTUAL, 4X, 
35HKPICK GMA ROOTS SOLVE) 


FORMAT (2X,13,1X,13,2X,11,2H (,11,1H),1X,13,2X,11,2H (,11,1H), 
2X,12,2H (,11,1H),2X,12,2X,E10.3, 2X, E1@.3, 2X, F5.2,2X,F5.2, 2X, 
F5.2,2X,18,2X,18, 2X,18, 2X, 18) 

STOP 

END 


FUNCTION RAN(XL, XU) 
FUNCTION RAN(XL,XU) GENERATES PSUEDO-RANDOM RSAL NUMBERS 
ON THE CLOSED INTERVAL (XL,XU) 
VERSION DATE: FEBRUARY 1, 1977. 

COMMON /RAN1/INIT,IINIT, ISAVE 
INIT=MOD (3125* INIT, 65536) 
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DRVRO470 
DRVRO48@ 
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DRVRO540 
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DRVRO560 
DRVRO570@ 
DRVRO580 
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DRVRO620 
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RAN=XL+ (XU--XL) * FLOAT (INIT) * (2. OE@** (-16) ) 
RETURN 
END 


INTEGER FUNCTION INTRAN(IL, IU) 
FUNCTION INTRAN(IL,IU) GENERATES PSUEDO-RANDOM INTEGERS 
ON THE CLOSED INTERVAL (IL, IU) 
VERSION DATE: FEBRUARY 1, 1977. 
COMMON /RAN1/LINIT, INIT, LSAVE 
INIT=MOD (3125* INIT, 65536) 
Q=FLOAT (INIT* (LU-IL+1) )* (2. @EQ@** (-16)) 
INTRAN=IL+INT (Q) 
RETURN 
END 


SUBROUTINE TEVAL(N,NTYPE, ITYPE,D,E, IDEF) 
SUBROUTINE TEVAL GENERATES A MATRIX OF ALLOWABLE TYPE 
USING PSUEDO-RANDOM NUMBERS FOR MATRIX ELEMENTS. 
VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION D(1),E(1) 
Q=1.0E@ 
IF ((IDEF.EQ.1).OR. (IDEF.EQ.3)) Q=-Q 
H=Q/FLOAT (N+1) 
IF(IDEF.GT.1) H=@.@E@ 
H2=H*H*Q 
X9=0. PEO 
XL=Q*1.E-3 
XU=Q 
NP1=N+1 
IF (NTYPE.EQ.2.OR.NTYPE.EQ.4) GO TO 15 
DO 5 I=1,NP1 
E(1)=RAN (XL, XU) 
IF (NTYPE.EQ.3) E(NPL)=E(1) 
DO 10 I=1,N 
D(1)=E(1)+E(1+1)+RAN(X@,H2) 
IF((IDEF.LE.1).OR.(NTYPE.EQ.3)) RETURN 
D(1)=E(2) 
D(N)=E(N) 
RETURN 
T1=RAN (XL, XU) 
T2=2.@E@*T1+RAN (XO,H2) 
DO 2@ I=1,NP1 
D(1)=T2 
E(1)=Tl 
IF (NTYPE.EQ.4) RETURN 
S2=SQRT (2.@E@)*T1 
IF(IDEF.GT.1) ITYPE=5 
IF(ITYPE.LE.3) GO TO 3¢ 
IF(ITYPE.GT.6) GO TO 25 
L=INTRAN(@, 1) 
IF(L.EQ.@) E(2)=S2 
IF(L.EQ.1) D(1)=T2-T1 
GO TO 30 
E(2)=S2 
D (1)=T2+RAN (X@, H) 
I=ITYPE-(ITYPE/3)*3 
IF(1.EQ.1) RETURN 
IF(I.EQ.@) GO TO 4@ 
L=INTRAN(@, 1) 
IF(L.EQ.@) E(N)=S2 
IF(L.EQ.1) D(N)=T2-T1l 
RETURN 
E(N)=S2 
D (N)=T2+RAN (X@,H) 
RETURN 
END 


SUBROUTINE RHS(N,NTYPE,TN1,TN2,M,MTYPE,TM1,TM2,IBDIM,B, 
IDEF, VN, VM, COEFF) 
SUBROUTINE RHS GENERATES A RIGHT HAND SIDE FOR SUBROUTINE 


RANOOO7@ 
RANGOO8O 
RANGOO9O 


TRANQGO1@ 
IRANQO20 
IRANOO 30 
LRANOO4 
IRANOO5@ 
IRANOO6O 
IRAN@Q7@ 
TRANGQ8O 
IRANOGIA 
IRAN@160 


TEVLOO1@ 
TEVLQ0O26 
TEVLO630 
TEVLOO4@ 
TEVLOG50@ 
TEVLOG60 
TEVLOO70 
TEVLOG8@ 
TEVLO69@ 
TEVLG10@ 
TEVL@11@ 
TEVL@120 
TEVL@130 
TEVLO14@ 
TEVLO15¢@ 
TEVLO160 
TEVLO17¢@ 
TEVLO18@ 
TEVL@190 
TEVLO260 
TEVLO21@ 
TEVLO22@ 
TEVLO230 
TEVLO240 
TEVLO250 
TEVLO260 
TEVLO27@ 
TEVLO280 
TEVLO290@ 
TEVLO360 
TEVLO31@ 
TEVLO320 
TEVLG33@ 
TEVL@340@ 
TEVL@35@ 
TEVL@360@ 
TEVLO37@ 
TEVL@38@ 
TEVLO390 
TEVLO400 
TEVLO410 
TEVL@420 
TEVL@430 
TEVLO440 
TEVL@450 
TEVLO46@ 
TEVLO470@ 
TEVL@480@ 
TEVL@49@ 
TEVLO500 
TEVLO51@ 
TEVL@520 


RHSOOG10 
RHS00026 
RHSO0030 


GMA USING PSUEDO-RANDOM NUMBERS. ISAVE STORES THE CURRENT VALUERHS@@@4@ 
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OF INIT, SO THAT SUBROUTINE NORM CAN REGENERATE THE EXACT 


SOLUTION. 


VERSION DATE: FEBRUARY 1, 1977. 


RHSO0050 


RHSOOG6O 
RHS00070 


DIMENSION TN1(1),TN2(1) ,TM1(1) ,T™2(1) ,B(IBDIM,1) ,VN(1) ,VM(1)RHSOOO80 


COMMON /RAN1/INIT, IINIT, ISAVE 
DOUBLE PRECISION §S 
ISAVE=INIT 
XL=-1.0E@ 
XU=1.QGEO 
NP1=N+1 
MP1=M+1 
DO 5 I=2,MP1 
DO 5 J=2,NP1 
B(I,J)=RAN (XL, XU) 
IF(MTYPE.GT.2) GO TO 15 
TM2(1)=0.@E@ 
DO 1¢ I=2,NP1 
B(1,1)=@.QEO 
B(M+2,1)=@.QE@ 
GO TO 25 
DO 2¢ I=2,NP1 
B(1,1)=B(MP1,I) 
B(M+2,1)=B(2,1) 
IF(NTYPE.GT.2) GO TO 35 
TN2(1)=0.@E@ 
DO 3@ I=2,MP1 
B(I,1)=@.QE@ 
B(I,N+2)=@.@E@ 
GO TO 45 
DO 4¢ I=2,MP1 
B(I,1)=B(1,NP1) 
B(I,N+2)=B(1I, 2) 
IF(IDEF.LE.1) GO TO 6@ 
COEFF=0. @E@ 
DO 55 J=2,NP1 
T=0.@EO 
DO 5@ I=2,MP1 
T=T+VM(I-1)*B(I,J) 
COEFF=COEFF+T*VN(J-1) 
TN2(NP1)=TN2(1) 
TM2 (MP1)=TM2 (1) 
DO 7@ J=2,NP1 
DO 7@ I=2,MP1 
S=(DBLE (TMI (I-1) )+DBLE(TN1 (J-1) ))*DBLE(B(1,J)) 
-DBLE (TM2 (I~-1) )*DBLE(B(I-1,J)) 
-DBLE (TM2 (1) )*DBLE(B(1I+1,J)) 
-DBLE(TN2(J-1))*DBLE(B(1,J-1)) 
-DBLE(TN2 (J) )*DBLE(B(1I,J+1)) 
B(I-1,J-1)=S 
RETURN 
END 


SUBROUTINE NORM(DIGITS,N,M, IBDIM,B, IDEF,VN,VM, COEFF) 
SUBROUTINE NORM CALCULATES THE NUMBER OF S{GNIFICANT 
DIGITS IN THE COMPUTED SOLUTION, MEASURED IN THE 2-NORM. 
THE EXACT SOLUTION IS GENERATED AS REQUIRED USING THE VALUE 
OF ISAVE. 
VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION B(IBDIM,1),VN(1),VM(1) 
COMMON /RANI1/INIT, LINIT, ISAVE 
DOUBLE PRECISION S 
INIT=ISAVE 
XL=-1.G0E@ 
XU=1.QEQ 
DIGITS=@.@E@ 
E1=@.QE@ 
E2=@.@E@ 
IF(IDEF.GT.1) GO TO 15 
DO 19 I=1,M 
DO 1¢ J=1,N 
U=RAN (XL, XU) 
S=DBLE(B(1, J) )-DBLE(U) 
EL=E1+S*S 
E2=E2+U*U 
GO TO 25 


RHSO0O90 
RHSGG100 
RHSGO110 
RHSGG129 
RHS@O130 
RHS0G14@ 
RHSO@150 
RHSGG16@ 
RHSOG170 
RHS9018@ 
RHSOO19@ 
RHSOG200 
RHS@0210 
RHS@@220 
RHSOG230 
RHSO0240 
RHS0G25@ 
RHS@026¢ 
RHS@6270@ 
RHS@6280@ 
RHSG029¢ 
RHSO0300 
RHSGO31@ 
RHS90320 
RHS00330 
RHSOO 340 
RHSOO350 
RHSGO36@ 
RHS00370 
RHS90G380 
RHS90390 
RHSOO400 
RHS0G41¢ 
RHSQ042¢6 
RHSGO430 
RHSQG44¢6 
RHSQ0450 
RHSQ646@ 
RHS@@47@ 
RHSO0480 
RHS0G649¢ 
RHSOO500 
RHS$0651@ 
RHS0@52¢ 
RHS@053¢ 
RHS006540@ 
RHS0655@ 


NORMOG1@ 
NORMGG2@ 
NORMOG30 
NORMGO40 
NORM@@50@ 
NORMGG60 
NORMO07@ 
NORM9G8¢ 
NORMGG9¢ 
NORMG14¢ 
NORMO11¢ 
NURMD 120 


NORM@130 
NORMG140 
NORM@15@ 
NORM@160 
NORM@170 
NORM@180@ 
NORM@190@ 
NORM@2060 
NORMO210 
NORM@22@ 
NORM@230 
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20 
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DO 2¢ I=1,M 
T=VM(L)*COEFF 
DO 2@ J=1,N 
U=RAN (XL, XU) -T*VN (J) 
S=DBLE(B(1,J))-DBLE (U) 
E1=E1+S*S 
E2=E2+U*U 
E1=E1/E2 
IF(E1.LT.1.Q@E@) DIGITS=-ALOG1@0(E1)/2.Q@E@ 
RETURN 
END 


SUBROUTINE KPICK(NPC,N,NTYPE,TN1,TN2,M,MTYPE,TM1,TM2, 
DEMAND ,K, COND, EMARCH, DIGITS, IFLAG) 


SUBROUTINE KPICK IS DESIGNED TO AID THE USER IN SELECTING 


THE MARCHING PARAMETER K TO BE USED AS INPUT FOR SUBROUTINES 
GMA AND GMAS. 


THE PARAMETER LIST: 


NPC IS AN INTEGER. IF NPC = 6, SUBROUTINE KPICK DETERMINES K 


NORM@24@ 
NORM@250@ 
NORM@26@ 
NORM@27@ 
NORM@28@ 
NORM@29@ 
NORMO300 
NORM@310 
NORMO 320 
NORMO33@ 
NORM@34@ 


KPIKGG1@ 
KPIKOO620@ 
KPIKGG3@ 
KPIKOG4@ 
KPIK0@5@ 
KPIKQGG60 
KPIKQ@7@ 
KP IKG@8@ 
KPIKGG90@ 


SUCH THAT THE SOLUTIONS COMPUTED USING SUBROUTINE GMA (GMAS)KPIK9160@ 


WILL HAVE APPROXIMATELY 'DEMAND' SIGNIFICANT DIGITS. 
IF NPC = 1, SUBROUTINE KPICK WILL TEST THE INPUT VALUE 
OF K. 

N,NTYPE,TN1,TN2,M,MTYPE,TM1,TM2 ARE IDENTICAL TO THE 
CORRESPONDING PARAMETERS IN THE CALLING SEQUENCE FOR 
SUBROUTINE GMA (GMAS). 

DEMAND IS A REAL NUMBER, STATING THE NUMBER OF SIGNIFICANT 
DIGITS DESIRED IN THE COMPUTED SOLUTION. IT MUST BE 
SPECIFIED ON INPUT IF NPC = @. 

K IS AN INTEGER. IF NPC = ¢, ON-OUTPUT K IS EQUAL TO THE 
MARCHING PARAMETER DETERMINED BY KPICK. IF NPC = 1, THE 
USER MUST SPECIFY THE VALUE OF K TO BE TESTED AS AN 
INPUT PARAMETER. 

COND IS A REAL NUMBER, NORMALLY RETURNING THE CONDITION 
NUMBER OF THE LINEAR SYSTEM. 

EMARCH IS A REAL NUMBER, NORMALLY RETURNING AN ESTIMATE OF 
THE ERROR DUE TO MARCHING FOR THE OUTPUT VALUE OF THE 
MARCHING PARAMETER K. 

DIGITS IS A REAL NUMBER, NORMALLY RETURNING A VALUE OF 
MAX( 6.0, -ALOG1@( ( COND + EMARCH ) * TOL ), WHERE TOL 
IS EQUAL TO THE MACHINE EPSILON. ‘THIS IS TYPICALLY THE 
NUMBER OF SIGNIFICANT DIGITS (IN THE 2 - NORM) ONE MAY 
EXPECT IN THE COMPUTED SOLUTION FOR THE GIVEN VALUE OF K. 

IFLAG IS AN INTEGER DESCRIBING ERROR RETURNS. 

IFLAG = @: NORMAL RETURN. 

IFLAG = 1: KPICK FAILED TO SUCCESSFULLY COMPUTE COND. THE 
ALGORITHM USED BY KPICK ASSUMES THAT THE LINEAR 
SYSTEM IS EITHER POSITIVE OR NEGATIVE DEFINITE. 

IF THE LINEAR SYSTEM IS POSITIVE OR NEGATIVE 
SEMI-DEFINITE WITH A ZERO EIGENVALUE OF MULTIPLICITY 
ONE, KPICK COMPUTES THE CONDITION NUMBER RELATIVE TO 
THE SUBSPACE ORTHOGONAL TO THE EIGENVECTOR ASSOCIATED 
WITH THE ZERO EIGENVALUE. OTHERWISE, KPICK RETURNS 


THE DEFAULT VALUES COND = EMARCH = DIGITS = @.¢@, 
AND K = 2 IF NPC = @. 
IFLAG = 2: KPICK HAS DETERMINED THAT THE MARCHING ERROR MAY 


NOT SATISFY THE ASSUMPTIONS UNDERLYING THE ALGORITHM 
USED TO COMPUTE EMARCH, AND THUS THE COMPUTED VALUE 
OF DIGITS MAY BE IN DOUBT. IF NPC = @, KPICK RETURNS 
ESTIMATES FOR K = 2. IF NPC = 1, KPICK RETURNS 
ESTIMATES FOR THE INPUT VALUE OF K. 

IFLAG = 3: CONDITIONS 1 AND 2 EXIST. 

IFLAG = 
VALUE OF K GREATER THAN OR EQUAL TO 2. 
ESTIMATES FOR K = 2. 
IF NPC = @. 


KPICK RETURNS 


IFLAG = 5: CONDITIONS 1 AND 4 EXIST. 

IFLAG = 6: CONDITIONS 2 AND 4 EXIST. 

IFLAG = 7: CONDITIONS 1, 2, AND 4 EXIST. 

IFLAG = 8: THE PARAMETERS N, NTYPE, TN1, AND/OR TN2 ARE 


INCORRECTLY SPECIFIED. 
IFLAG = 9: THE PARAMETERS M, MIYPE, TM1, AND/OR TM2 ARE 
INCORRECTLY SPECIFIED. 


4: THE REQUESTED DEMAND CANNOT BE SATISFIED BY ANY 


THIS ERROR RETURN CAN OCCUR ONLY 


KPIK@11@ 
KPIK@12@ 
KPIK@13@ 
KPIK@14@ 
KPIK@1L5@ 
KPIK@16@ 
KPIK@170@ 
KPIK@18@ 
KPIK9O19@ 
KPIK@20@ 
KPIK@21@ 
KPIK@220 
KPIK@23@ 
KPIK@24@ 
KPIK@250 
KPIK@26@ 
KPIK@27@ 
KPIK@28@ 
KPIKG290@ 
KPIKG300 
KPIKO310 
KPIK@320 
KPIKQ330 
KPIKG34@ 
KPIK@350 
KPIK936@ 
KPIK@370@ 
KPIKG38¢@ 
KPIK@39@ 
KPIK@40@ 
KPIK@41@ 
KPIK@42¢ 
KPIKO430@ 
KPIK@440@ 
KPIK@45@ 
KPIK@46@ 
KPIK@47@ 
KPIKG48@ 
KPIKO49@ 
KPIKQ@50@ 
KPIKQO51@ 
KPIKQ@52@ 
KPIK@53@ 
KPIKQ54@ 
KPIK@55@ 
KPIKQ56@ 
KPIK@57@ 
KPIKQ58@ 
KPIKQ59@ 
KPIK@600 
KPIK@61@ 
KPIKQ62@ 
KPIK@630 
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IFLAG = 1@: CONDITIONS 8 AND 9 EXIST. 


IF IFLAG = @, 2, 4, 6, THEN THE LINEAR SYSTEM IS SUITABLE 
FOR SUBROUTINE GMA, WITH THE QUALIFICATIONS NOTED ABOVE. 
IF IFLAG = 1, 3, 5, 7, WITH OTHER THAN DEFAULT VALUES FOR 
COND, EMARCH, AND DIGITS, THEN THE LINEAR SYSTEM IS SUITABLE 
FOR SUBROUTINE GMAS, WITH THE QUALIFICATIONS NOTED ABOVE. 


KPICK CONTAINS ONE LABELED COMMON BLOCK, /MACHEP/, 
CONTAINING ON VARIABLE, TOL. TOL IS A MACHINE DEPENDENT 
CONSTANT EQUAL TO THE MACHINE EPSILON. IT IS INITIALIZED IN 
KPICK IN THE FIRST EXECUTABLE STATEMENT. 


ADDRESS INQUIRIES TO: 
RANDOLPH E. BANK 
DEPARTMENT OF MATHEMATICS 
THE UNIVERSITY OF CHICAGO 
CHICAGO, ILLINOIS 60637 


VERSION DATE: FEBRUARY 1, 1977. 
DIMENSION TN1(1),TN2(1),TM1 (1) ,T2(1) 
COMMON /MACHEP/TOL 
TOL=2.@E@** (-23) 
ESTABLISH DEFAULT VALUES 
IFLAG=@ 
IF(NPC.NE.1) K=2Z 
COND=@. GE@ 
EMARCH=@. GEO 
DIGITS=@.@E@ 
NN=N 
IF(NTYPE.GE.3) NN=N-1 
CHECK MATRIX SPECIFivVATIONS. 
JFLAG=8 
CALL TCHECK(N,NTYPE,TN1,TN2,IFLAG, JFLAG) 
JFLAG=9+IFLAG/8 
CALL TCHECK(M,MTYPE, TMI ,TM2, IFLAG, JFLAG) 
IF(IFLAG.NE.@) RETURN 
DETERMINE IF THE SYSTEM IS POSITIVE OR NEGATIVE DEFINITE. 
NS=2 
MS=2 
CALL EIGEN(N,NTYPE,TN1,TN2,1,TNMIN) 
CALL EIGEN(N,NTYPE,TN1,TN2,N,TNMAX) 
CALL EIGEN(M,MTYPE,TM1 ,TM2,1,TMMIN) 
CALL EIGEN(M,MTYPE,TM1 ,TM2,M,TMMAX) 
IF (ABS (TMMAX+TNMAX) .GT .ABS (TMMIN+TNMAX)) GO TO 5 
MS=M-1 
T1=TMMAX 
TMMAX=TMMIN 
TMMIN=T1 
IF (ABS (TMMAX+TNMAX) .GT .ABS (TMMAX+TNMIN)) GO TO 10 
NS=N-1 
T1=TNMAX 
TNMAX=TNMIN 
TNMIN=T1 
T1=TMMAX+TNMAX 
T2=TMMIN+TNMIN 
IF(T2/T1.GT.TOL) GO TO 15 
IF THE MATRIX IS NOT POSITIVE OR NEGATIVE DEFZNITE, 
DETERMINE IF IT IS POSITIVE OR NEGATIVE SEMI-DEFINITE 
WITH A ZERO EIGENVALUE OF MULTIPLICITY ONE. 
IFLAG=1 
IF (ABS (T2) .GT.ABS(T1)*TOL) RETURN 
CALL EIGEN(N,NTYPE,TN1,TN2,NS,TNSNG) 
CALL EIGEN(M,MTYPE,TM1 ,TM2,MS,TMSNG) 
T2=TMMIN+TNSNG 
T3=TMSNG+TNMIN 
IF (ABS(T2) .GT.ABS(T3)) T2=T3 
IF(T2/T1.LE.TOL) RETURN 
DETERMINE THE CONDITION NUMBER OF THE LINEAR SYSTEM. 
THE VALUE GF + SQRT( GF * GF - 1. ) IS AN ESTIMATE OF THE 
EXPONENTIAL GROWTH PER MARCHING STEP. 
COND=T1/T2 
GF=(2.@EQ@* TMMAX+TNMAX+TNMIN) / (TNMAX-TNMIN) 
BIG=COND/TOL 
IF(NPC.EQ.1) GO TO 5@ 
ESTIMATE AN UPPER BOUND FOR K, KMAX, BASED ON AN EXPONENTIAL 


KP IKQ64@ 
KPIK@65@ 
KPIKQG66@ 
KPIK@67@ 
KPIKG68@ 
KPIKG69@ 
KP IKO70@ 
KPIKQ71@ 
KPIK@72@ 
KPIKO73@ 
KP IK074@ 
KPIK@75@ 
KPIK@76@ 
KPIK@77@ 
KP IKO78@ 
KPIKO79@ 
KPIKO8@¢ 
KPIK@81¢ 
KPIK982¢ 
KPIK@83@ 
KPIK@84@ 
KPIKO85@ 
KPIKO86@ 
KPIK@87@ 
KPIK@88@ 
KPIKG89@ 
KPIKQ960 
KPIKO91@ 
KPIK@92@ 
KPIK993@ 
KPIKQG94@ 
KPIK@95@ 
KPIKQO96@ 
KPIKQ097@ 
KPIKG98@ 
KPIKG99¢@ 
KPIK1060¢ 
KPIK1@1@ 
KPIK1¢62@ 
KPIK193@ 
KPIK1@4@ 
KPIK165¢ 
KPIK106@ 
KPIK167@ 
KPIK108@ 
KPIK1069@ 
KPIK1160 
KPIK111@ 
KPIK112@ 
KPIK113@ 
KPIKL14@ 
KPIK115@ 
KPIK116@ 
KPIK117@ 
KPIK1L18@ 
KPIK119@ 
KPIK120@ 
KPIK121@ 
KPIK122@ 
KPIK123@ 
KPIK124@ 
KPIK125@ 
KPIK126@ 
KPIK127@6 
KPIK128@ 
KPIK129@ 
KPIK13@@ 
KPIK131@ 
KPIK132@ 
KPIK133@ 
KPIK134@ 
KPIK135@ 
KPIK136@ 
KPIK137@ 
KPIK138@ 
KPIK139¢@ 
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GROWTH OF 2.5 PER MARCHING STEP. 

IF KEST SATISFIES DEMAND, CHECK THE VALUE OF GF. 
IS LESS THAN 2.5 SET IFLAG = 2. OTHERWISE ACCEPT 
KEST AS A SUITABLE VALUE FOR K. 

IF (DEMAND .LE.@.@E@) GO TO 45 

TARGET= (10. @EQ@** (~DEMAND) ) /TOL-COND 

IF (TARGET .LE.15.625E@) GO TO 45 
KEST=ALOG1@ (TARGET) /ALOG1@(2.5E@) 

IF (IFLAG.EQ.1) KEST=MIN@(KEST,N) 

CALL ERROR (EMARCH, BIG,TMMAX,NN,TN1 ,TN2,KEST ,ND) 
IF (EMARCH.GT.TARGET) GO TO 2@ 
IF(GF.LE.1.45E@) GO TO 5¢ 

GO TO 4¢ 

KMAX=NN/ (ND+1)+1 

CHECK IF KMIN = 2 IS A LOWER BOUND FOR K. 
KMIN=2 

CALL ERROR (EMARCH, BIG, TMMAX ,NN,TN1 ,TN2,KMIN,ND) 
IF (TARGET.LT.EMARCH) GO TO 45 

FIND K USING THE METHOD OF BISECTION. 

KEST= (KMAX+KMIN) /2 

CALL ERROR (EMARCH, BIG, TMMAX,NN,TN1,TN2,KEST,ND) 
IF(KEST.EQ.KMIN) GO TO 4@¢ 

IF (TARGET-EMARCH) 30,4@, 35 

KMAX=NN/ (ND+1)+1 

GO TO 25 

IF(ND.EQ.@) GO TO 4@ 

KMIN=NN/ND 

GO TO 25 

K=KEST 

IF(K.NE.2) K=NN/(ND+1)+1 
T1=(COND+EMARCH) *TOL 

IF(T1.LT.1.@E@) DIGITS=-ALOG1@(T1) 
RETURN 

IF NPC = 1, TEST THE INPUT VALUE OF K. 
TEST THE VALUE K = 2 FOR ERROR RETURNS. 
IFLAG=IFLAG+4 

KEST=K 

IF (IFLAG.EQ.1) KEST=MIN@(KEST,N) 

CALL ERROR (EMARCH, BIG, TMMAX,NN,TN1,TN2,KEST,ND) 
IF(GF.LE.1.45EQ@) IFLAG=IFLAG+2 
T1=(COND+EMARCH) *TOL 

IF(T1.LT.1.@E@) DIGITS=-ALOG16(T1) 

RETURN 

END 


IF NPC = @, 


SUBROUTINE TCHECK(N,NTYPE,D,E, IFLAG, JFLAG) 


SUBROUTINE TCHECK DETERMINES IF THE INPUT DATA HAS BEEN 


CORRECTLY SPECIFIED BY THE USER. 
VERSION DATE: FEBRUARY 1, 1977. 

DIMENSION D(1),E(1) 

COMMON /MACHEP/TOL 
IF(N.LT.3) GO TO 50 
IF(NTYPE.LT.1) GO TO 50 
IF(NTYPE.GT.4) GO TO 5@ 

GO TO (5,25,1@, 306) ,NTYPE 
Il=2 

GO TO 15 

I1=1 

DO 2@ I=I1,N 

IF(E(1I) .EQ.@.@E@) GO TO 506 
CONTINUE 
RETURN 
IF(N.EQ.3) GO TO 5 
Ils3 
12=N~1 
GO TO 35 
LS) 

I2=N 

D1=D (2) 

D2=ABS (D1) *1@. GE@*TOL 
IF(D1.EQ.0.G@E@) D2=16.GE@*TOL 
E1=E (3) 

E2=ABS (E1)*10. @EO* TOL 
IF(E1.EQ.@.@E@) GO TO 5¢ 

DO 49 I=I1,12 


KPIK1460 


IF THE GROWTH KPIK141¢ 


KPIK1420@ 
KPIK143@ 
KPIK144@ 
KPIK145@ 
KPIK1460 
KPIK147@ 
KPIK148@ 
KPIK149@ 
KPIK150@ 
KPIK151@ 
KPIK152@ 
KPIK153@ 


IF NOT SET IFLAG = 4.KPIK154@ 


KPIK155@ 
KPIK156@ 
KPIK157@ 
KPIK158@ 
KPIK159@ 
KPIK16@0@ 
KPIK161¢ 
KPIK1620 
KPIK163@ 
KPIK1640 
KPIKL65@ 
KPIK166@ 
KPIK167@ 
KPIK168@ 
KPIK169@ 
KPIK170@ 
KPIK17106 
KPIK172@ 
KPIK173@ 
KPIK174@ 
KPIK175@ 
KPIK176@ 
KPIK177@ 
KPIK178@ 
KPIK179@ 
KPIK18@@ 
KPIK181@ 
KPIK1820@ 
KPIK183@ 


TCHKG@1@ 
TCHKGG26 
TCHK9@30 
TCHKQ@4@ 
TCHKQO5@ 
TCHKG@6@ 
TCHKO@7@ 
TCHKGO80 
TCHKOO9@ 
TCHKO146@ 
TCHKO11@ 
TCHK@12@ 
TCHK@1 3¢ 
TCHKG14@ 
TCHK@15@ 
TCHKG16@ 
TCHK@176 
TCHKO18@ 
TCHKO190@ 
TCHKQ266 
TCHK@21@ 
TCHKO226 
TCHKO2 30 
TCHKO24@ 
TCHK@25@ 
TCHKO26@ 
TCHK@27@ 
TCHKG28@ 
TCHKG29@ 
TCHKO 360 
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IF (ABS (D1-D(I)).GT.D2) GO TO 5¢@ 
IF (ABS(E1-E(1)).GT.E2) GO TO 5¢ 

CONTINUE 

IF (E(2) .EQ.@.QE@) GO TO 5¢ 

IF(E(N) .EQ.0.9E@) GO TO 5¢ 

RETURN 

LFLAG=J FLAG 

RETURN 

END 


TCHKO310 
TCHKO320 
TCHKO330 
TCHKO340 
TCHKO350@ 
TCHKO36@ 
TCHKO370 
TCHKO380 
TCHKO390 
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ALGORITHM 528 
Framework for a Portable Library [Z] 


P. A. FOX, A. D. HALL, and N. L. SCHRYER 
Bell Laboratories 


Key Words and Phrases: portability, mathematical libraries, error handling, stor- 
age management, memory allocation, machine dependencies 

CR Categories: 4.4, 5.1 

Language: Fortran 


DESCRIPTION 


The three program packages presented here provide a framework for a portable 
Fortran subroutine library. They were developed for the Bell Laboratories library 
PORT [1]. The packages are: machine-dependent constants, automatic error 
handling, and dynamic storage allocation using a stack. There are interdependen- 
cies among the packages in the sense that the error handling is used by both the 
others, and it in turn uses machine-dependent constants provided by the first. 
However, care is taken to avoid any actual or apparent recursion. 

Two non-ANSI Standard Fortran assumptions are made in the algorithm. The 
first is that there is no runtime subscript range checking; the second is that 
variables (local to a subprogram) initialized by DATA statements, and then 
changed within the subprogram, keep their values from one invocation of the 
subprogram to the next. Appendix A of [1] discusses nonstandard usage in more 
detail. 


REFERENCES 
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Machine-Dependent Constants 


The first package contains three Fortran function subprograms which can be 
invoked to determine basic machine or operating system dependent constants. 
Values are provided in commented DATA statements for the Burroughs 5700/ 
6700/7700, the CDC 6000/7000 series, the Data General Eclipse, DEC PDP 10 
(KA and KI processors), the DEC PDP 11, the Harris S220, the Honeywell 6000 
series, the IBM 360/370 series, the SEL systems 85/86, the Univac 1100 series, 
the XEROX SIGMA 5/7/9; others can be added. When the library is moved to 
a new environment, only the appropriate DATA statements in these three 
subprograms need to be activated by removing the C’s from column 1. 

The three functions are: I1MACH, which delivers integer constants, RIMACH, 
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which delivers single-precision floating-point (REAL) constants, and DIMACH, 
which delivers double-precision floating-point constants. These functions have a 
single integer argument indicating the particular constant desired. For example, 
RIMACH(2) is the largest single-precision floating-point number on the host 
machine, so the statement 


XMAX = RIMACH(2) 
sets XMAX to this largest number. 


The machine-dependent values provided are defined in the listing given here. 
(Please note that the systems for which the machine constants are given are 
printed here in alphabetical order but that their corresponding sequence num- 
bers are not in numerical order.) Details of constant specification and usage are 
described in [1]. 


ALGORITHM 


[Only the PORT utility programs are included here. A Users’ Guide and test 
programs are available upon request from the ACM Algorithms Distribution 
Service. | 


INTEGER FUNCTION I1MACH(I) MCEIOOOO 
MCHIOG20 

I/O UNIT NUMBERS. MCHIOO46 
MCHIGG6@ 

THE STANDARD INPUT UNIT. MCHIOO8@ 
MCHIGO160 

THE STANDARD OUTPUT UNIT. MCHIO126 
MCHIO14¢ 

THE STANDARD PUNCH UNIT. MCHIO160 
MCHIO18@ 

THE STANDARD ERROR MESSAGE UNIT. MCHIO260 
MCHIG22¢ 

WORDS. MCHIQO246 
MCHIO26¢ 

TEE NUMBER OF BITS PER INTEGER STORAGE UNIT. MCHI6280 
MCHIO300 

TEE NUMBER OF CHARACTERS PER INTEGER STORAGE UNIT. MCHIGO326 
MCHIO346 

INTEGERS. MCHIO36¢@ 
MCHIQ38¢@ 

ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, EASE-A FORM MCHIG40606 
MCHIO426 

SIGN ( X(S-1)*A**(S-1) + ... + X(L)*A + X(Q) ) MCHI@446 

MCHIO460 

WHERE @ .LE. X(I) .LT. A FOR I=@,...,S$-1. MCHI@48@ 

MCHIO500 

I1MACH( 7) = A, THE BASE. MCHIO652@ 
MCHIO540 

S, THE NUMBER OF BASE-A DIGITS. MCHIO56@ 
MCHIO58@ 

A**S - 1, THE LARGEST MAGNITUDE. MCH1I@600 
MCHIG62¢ 

FLOATING-POINT NUMBERS. MCHIG64¢ 
MCHI@66@ 

ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, MCHIG68@ 
BASE-B FORM MCHIG70¢ 
MCH1O72@ 

SIGN (B*¥*E)*( (X(1)/B) + ... + (X(L)/E**T) ) MCHIG740@ 

MCHIG76@ 

WEERE @ .LE. X(I) .LT. B FOR I=1,...,T, MCHIO78@ 

@ .LT. X(1), AND EMIN .LE. E .LE. EMAX. MCHIO8OO 

MCHIQ82@ 

I1IMACH(16) = B, THE BASE. MCHIQ84¢6 
MCHIO866 

SINGLE-PRECISION MCHIG886 
MCHIG900 

ILMACH(11) = T, THE NUMBER OF BASE-B DIGITS. MCHIO9 206 
MCHIO94¢6 


I1MACH( 1) 


IIMACH( 2) 


IT1MACH( 3) 


IT1MACH( 4) 


I1MACH( 5) 


ITIMACH( 6) 


TIMACH( 8) 


I1MACH( 9) 


AFAAIQAIAIARAAANAANAARNDANQNADAAANAANAANAANAANAAAANANAANAAAANDA 


COLLECTED ALGORITHMS (cont.) 


AARAARAAANANAANRAARAANANDAN 


a 


QAANQNAANDQDANQAARAAAAAAAAANDAADAAARAAANQAANANAQAAARAARAANRAAANANAANANMAANAANAAMAANANAARAAANRNNRAAAN 


I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. 


T1MACH(13) = EMAX, THE LARGEST EXPONENT E. 


DOUBLE-PRECISION 


TIMACH (14) 


T, THE NUMBER OF BASE-B DIGITS. 


T1MACH(15) = EMIN, THE SMALLEST EXPONENT E. 


T1MACH(16) 


TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, 
THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY 


EMAX, THE LARGEST EXPONENT E. 


REMOVING THE C FROM COLUMN 1. ALSO, THE VALUES OF 


IIMACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY 


WITH THE LOCAL OPERATING SYSTEM. 


INTEGER IMACH(16) ,OUTPUT 


EQUIVALENCE (IMACH(4) ,OUTPUT) 


MACHINE CONSTANTS FOR 


DATA 
DA™ 4 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


IMACK( 1) 
IMACH( 2) 
IMACH( 3) 
IMACH( 4) 
IMACH( 5) 
IMACH( 6) 
IMACH( 7) 
IMACH( 8) 
IMACH( 9) 
IMACH (10) 
IMACH (11) 
IMACH (12) 
IMACH (13) 
IMACK (14) 
IMACH (15) 
IMACH (16) 


/ 
/ 
/ 
/ 
/ 
/ 
/ 
'j 
/ 
/ 
/ 
/ 
/ 
/ 
/ 
/ 


Lee) 


“A Uo 
PM WNHDNNNDY AY 


MMR MRS Rn 


ZIFFFFFFFF / 


MACHINE CONSTANTS FOR THE BURROUGHS 5706@ SYSTEM. 


DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


MACHINE CONSTANTS FOR THE BURROUGHS 670606/770@ SYSTEMS. 


DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
LATA 
DATA 
DATA 
DATA 
DATA 
DATA 


IMACH( 1) 
IMACH( 2) 
IMACH( 3) 
IMACH( 4) 
IMACH( 5) 
IMACH( 6) 
IMACH( 7) 
IMACH( 8) 
IMACH( 9) 
IMACH (1) 
IMACH (11) 
IMACH (12) 
IMACH (13) 
IMACH (14) 
IMACH (15) 
IMACH (16) 


IMACH( 1) 
IMACH( 2) 
IMACH( 3) 
IMACH( 4) 
IMACH( 5) 
IMACHi( 6) 
IMACH( 7) 
IMACH( 8) 
IMACH( 9) 
IMACH (1) 
IMACH(11) 
IMACH (12) 
IMACH (13) 
IMACH (14) 


mA MA MH MH, MR MR MR MR MR BR MR 


™ 


/ 
/ 
/ 


NOAN A UW 
~NR 


lo 
old) 


00007777777777777 / 
8 / 
13 / 
-5@ / 
76 / 
26 / 
~50 / 
76 / 


NODAANAUY 
~ ™ R M R 


090007777777777777 / 
8 / 
13 / 
-5¢ / 
76 / 
26 / 


THE BURROUGHS 1/@@ SYSTEM. 


MCHIG96@ 
MCHIO98¢@ 
MCHI1600 
MCHI162¢ 
MCHI 10640 
MCHI1@6¢ 
MCHI1068¢ 
MCHI116¢ 
MCHI112¢ 
MCHI114¢ 
MCHI116¢ 
MCHI118¢ 
MCEI12¢6@ 
MCHI122¢ 
MCHI124@ 
MCHI126@ 
MCHI12890 
MCHI13@0 
MCHI132@ 
MCHI134@ 
MCHI136@ 
MCHI138¢@ 
MCHI488@ 
MCHI4900 
MCHI49206 
MCHI494@ 
MCHI4960@ 
MCHI498@ 
MCHI5600 
MCHI5@26 
MCHI5046 
MCHI5@60 
MCHI508@ 


MCHI516¢ 
MCHI5120 


MCHI514@ 
MCHI516@ 
MCHI518@ 
MCHI5206¢ 
MCHI522¢ 
MCHI524@ 
MCHI450¢ 
MCHI4526 
MCHI454@ 
MCK1I456@ 
MCHI458@ 
MCHI 4660 
MCHI4620 
MCHI464@ 
MCHI466@ 
MCHI468@ 
MCHI476@ 
MCHI472@ 
MCHI474@ 
MCHI476@ 
MCHI478@ 
MCHI486@ 
MCHI482@ 
MCHI484@ 
MCHI 4860 
MCHI412¢ 
MCEI414¢ 
MCHI416@ 
MCHI418¢ 
MCHI4206@ 
MCHI422@ 
MCHI424@ 
MCH1426@ 
MCHI428@ 
MCHT43060 
MCHI432@ 
MCHI434@ 
MCHI436@ 
MCHI438@ 
MCHI440¢ 
MCHI4420 
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MNANMQNANQAAANAAGQAAAANAANANIANAQANANAANDANAAADAAANAAANAQAANANAAAAAAANQAAANQAAARAAANAANQAAANAAANDANAANRAANRNMNAAANAAN 


DATA IMACH(15) / -32754 / 


DATA IMACH(16) / 


MACHINE CONSTANTS FOR THE CDC 6060/7400 SERIES. 


DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


MACHINE CONSTANTS FOR THE CRAY 1 


DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/2@@ 


DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


IMACH( 1) 
IMACH( 2) 
IMACH( 3) 
IMACH( 4) 
IMACH( 5) 
IMACH( 6) 
IMACH( 7) 
IMACK( 8) 
IMACH( 9) 
IMACH (10) 
IMACH(11) 
IMACH (12) 
IMACH(13) 
IMACH (14) 
IMACH (15) 
IMACH (16) 


IMACH( 1) 
IMACH( 2) 
IMACH( 3) 
IMACH( 4) 
IMACH( 5) 
IMACH( 6) 
IMACH( 7) 
IMACH( 8) 
IMACH( 9) 
IMACH (10) 
IMACH (11) 
IMACH (12) 
IMACH (13) 
IMACH(14) 
IMACH (15) 
IMACH (16) 


IMACH( 1) 
IMACH( 2) 
IMACH( 3) 
IMACH( 4) 
IMACH( 5) 
IMACH( 6) 
IMACH( 7) 
IMACH( 8) 
IMACH( 9) 
IMACH (14) 
IMACH (11) 
IMACH (12) 
IMACH (13) 
IMACH (14) 
IMACH (15) 
IMACH (16) 


~™MR™ BR MRR RR MRR MMR MR BBR MB MR BR 


mM MA Mn MR Mn MR, MR. MR MR MR MR MR MR MR TR 


32780 / 


48 


$0007777777777777777B / 


2 

48 
-974 
1070 
96 
-927 
1676 


16¢ 
191 


11 
12 


MACHINE CONSTANTS FOR 


DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


IMACH( 1) 
IMACH( 2 
IMACH( 3) 
IMACH( 4) 
IMACH( 5) 
IMACH( 6) 
IMACH( 7) 
IMACH( 8) 
IMACH( 9) 
IMACH (14) 
IMACH (11) 
IMACh(12) 
IMACK (13) 
IMACH (14) 


me MR MTR MR MR MR MR 


~™ T™ M M S 


hm TA TM TM MR MR RR TR MR, BR TR RL TR TR 


THE HARRIS 22@ 


me MA MR MA, MR MR MR MR MR HR MR RR 


MCHI4440 
MCHI4460 
MCHI448@ 
MCHI218@ 
MCHI220@ 
MCHI222@ 
MCHI224@ 
MCHI226@ 
MCHI228¢ 
MCHI230@ 
MCHI232@ 
MCHI234¢ 
MCH1I236@ 
MCH12389@ 
MCHI240¢ 
MCHI242¢ 
MCHI244@ 
MCHI246@ 
MCHI248@ 
MCHI2500 
MCHI252@¢ 
MCHI254@ 


MCHI5720 
MCHI574@ 
MCHI576@ 
MCHI578@ 
MCKI580¢ 
MCHI582@ 
MCHI584@ 
MCHI586¢@ 
MCHI588@ 
MCHI5900 
MCHI592@ 
MCHI594@ 
MCHI596¢@ 
MCHI598¢ 
MCHL60060 
MCHI692@ 
MCHI604¢ 
MCHI606¢ 
MCHI608@ 
MCHI1614@ 
MCHI612¢ 
MCHI6146 
MCHI6160 
MCHI618¢ 
MCH1620@ 
MCHI622¢ 
MCHI624@ 
MCHI626¢6 
MCH1628¢ 
MCHI6306¢ 
MCHI632@ 
MCHI6 346 
MCHI636¢ 
MCHI6 380 
MCHI 6400 
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hort 


AAMAAAQAANANANAANANAANADANAANANAANAANAAAANNAANANAMNADNAMAAANAANANAANAANAANANANAAANANANA AANNAANAAAAAANAAANAANA 


DATA IMACH(15) / -127 / 
DATA IMACH(16) / 127-7 


MACHINE CONSTANTS FOR THE HONEYWELL 6066/600@ SERIES. 


DATA IMACH( 1) / 5 / 
DATA IMACH( 2) / 6 / 
DATA IMACH( 3) / 43 / 
DATA IMACH( 4) / 6 / 
DATA IMACH( 5) / 36 / 
DATA IMACH( 6) / 6 / 
DATA IMACH( 7) / 27 
DATA IMACH( 8) / 35 / 
DATA IMACH( 9) / 0377777777777 / 
DATA IMACH(1@) / rae 
DATA IMACH(11) / 27 / 
DATA IMACH(12) / -127 / 


MCHI642@ 
MCHI6446 
MCHI646@ 
MCHI1460 
MCHI142@ 
MCHI144@ 
MCHI146¢ 
MCHI148¢ 
MCHI1506¢ 
MCHI152¢ 
MCHI154¢ 
MCHI156@ 
MCHI158@ 
MCHI1606¢ 
MCHI162@ 
MCHI164¢@ 
MCHI166¢ 


course: intro to tso,part 2, thursday 16 march, 7-9 pm, room 354 ml OPER 


DATA IMACK(13) / 127 / 
DATA IMACH(14) / 63 / 
DATA IMACH(15) / -127 / 
DATA IMACH(16) / 127 / 


MACHINE CONSTANTS FOR THE IBM 366/370 SERIES, 
THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. 


DATA IMACH( 1) 
DATA IMACH( 2) 
DATA IMACK( 3) 
DATA IMACH( 4) 
DATA IMACH( 5) 
DATA IMACH( 6) 
DATA IMACK( 7) 
DATA IMACH( 8) 
DATA IMACK( 9) 
DATA IMACK(16) / 16 / 
DATA IMACH(11) / 6 / 
DATA IMACH(12) / -64 / 
DATA IMACH(13) / 63 / 
DATA IMACH(14) / 14 / 
DATA IMACH(15) / -64 / 
DATA IMACH(16) / / 


5 
6 
7 
6 
2 
4 
2 


31 


mA TM MA MA MR MR 
Ww 


MACHINE CONSTANTS FOR THE PDP-1@ (KA PROCESSOR). 


DATA IMACH( 1) 
DATA IMACH( 2) 
DATA IMACH( 3) 
DATA IMACH( 4) 
DATA IMAGH( 5) 
DATA IMACH( 6) 
DATA IMACH( 7) 
DATA IMACH( 8) 
DATA IMACH( 9) 
DATA IMACH(19) 
DATA IMACH(11) 
DATA IMACH(12) 
DATA IMACK(13) 
DATA IMACH(14) 
DATA IMACH(15) 
DATA IMACH(16) 


~~ MA MR RR RR 


"O777TITTT TTT A 
2 


mS MA MR Rn MR MR MR MR MR MR MR MR BR MR MR, 
(es) 
Wi bo 


— 
No 
~s 
~RRR R 


MACHINE CONSTANTS FOR THE PDP-1@ (KI PROCESSOR). 


DATA IMACH( 1) 
DATA IMACH( 2) 
DATA IMACH( 3) 
DATA IMACH( 4) 


BOUND UDNWN 
TMA Rs BR BR 


/ 

/ 

/ 

/ 
DATA IMACH( 5) / 36 
DATA IMACH( 6) / 
DATA IMACH( 7) / 
DATA IMACH( 8) / 35 / 
DATA IMACK( 9) / "377777777777 / 
DATA IMACH(1@) / 2 / 
DATA IMACH(11) / 27 / 
DATA IMACH(12) / -128 / 


MCHI168@ 
MCHI1706¢ 
MCHI172¢ 
MCHI174@ 
MCHI176@ 
MCH1178¢@ 
MCHI18¢¢ 
MCHKI182¢ 
MCHI184@ 
MCEI186@ 
MCHI188¢@ 
MCHI 1969 


MCHI192@° 


MCHI194@ 
MCHI196@ 
MCHI198@ 
MCHI 2600 
MCHI 20626 
MCHI2064@ 
MCHI2060 
MCHI 2680 
MCHI2106 
MCHI212¢ 
MCHI214@ 
MCHI216@ 
MCHI256@ 
MCHI258@ 
MCHI2606¢ 
MCHI262¢ 
MCHI264@ 
MCHI266@ 
MCHI268¢ 
MCHI270@ 
MCHI272@ 
MCHI274¢ 
MCHI276@ 
MCH1278¢@ 
MCHI 2860 
MCHI282@ 
MCHI284@ 
MCHI286@ 
MCHI288@ 
MCHI2990@ 
MCHI 2920 
MCHI294@6 
MCHI296@ 
MCHI298¢ 
MCHI306¢ 
MCH13020 
MCHI304¢ 
MCHI366¢ 
MCH1I308¢@ 
MCHI314¢ 
MCHI312@ 
MCHI314¢ 
MCHI316¢ 
MCHI318@ 
MCHI32¢6¢ 
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AANQAANAAARAAAAAAAAAAAGDANQANAQANGAANNAANANQNANAANAAARAAAANARANRAAANAAAMAANAANnNANANMAANAAMAaANANaAANAAAN 


io) 


C 


C 


DATA IMACH(13) / 127 / 
DATA IMACH(14) / 62 / 
DATA IMACH(15) / -128 / 
DATA IMACH(16) / 127 / 


MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING 
32-BIT INTEGER ARITHMETIC. 


DATA IMACH( 1) / 5 / 
DATA IMACH( 2) / 6 / 
DATA IMACH( 3) / 5 / 
DATA IMACH( 4) / 6 / 
DATA IMACH( 5) / 32 / 
DATA IMACH( 6) / 4 / 
DATA IMACH( 7) / ay 
DATA IMACH( 8) / 31 / 
DATA IMACH( 9) / 2147483647 / 
DATA IMACH(1@) / 20) 
DATA IMACH(11) / 24 


DATA IMACH(12) / ~-127 
DATA IMACH(13) / 127 
DATA IMACH(14) / 56 
DATA IMACH(15) / -127 
DATA IMACH(16) / 127 


™ MA 


MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING 
16-BIT INTEGER ARITHMETIC. 


DATA IMACH( 1) 
DATA IMACH( 2) 
DATA IMACH( 3) 
DATA IMACH( 4) 
DATA IMACH( 5) 
DATA IMACH( 6) 
DATA IMACK( 7) 
DATA IMACH( 8) 
DATA IMACH( 9) 
DATA IMACH(14) 
DATA IMACH(11) 
DATA IMACH(12) 
DATA IMACH(13) 
DATA IMACH(14) / 56 
DATA IMACH(15) / -127 
DATA IMACH(16) / 127 


wm TR TMA TH TM TM TH TR TM TS 
Ww 
No 
wl 
fo) NO 
~ 
~ MA TM Me MH 
~— 


ro 
N 
wd 
i i a 


MACHINE CONSTANTS FOR THE UNIVAC 1106¢@ SERIES. 


NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 
WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. 
IF YOU HAVE THE UNIVAC-FIN SYSTEM, SET IT TO l. 


DATA IMACH( 1) 
DATA IMACH( 2) 
DATA IMACH( 3) 
DATA IMACH( 4) 
DATA IMACH( 5) 
DATA IMACH( 6) 
DATA IMACH( 7) 
DATA IMACH( 8) 
DATA IMACH( 9) 
DATA IMACh(10) 
DATA IMACH(11) 
DATA IMACH(12) 
DATA IMACH(13) 
DATA IMACHi 14) 
DATA IMACH(15) /-1624 
DATA IMACH(16) / 1423 


~NRRRRR 
Ww 
wo 


IF (I .LT. 1 .OR. I .GT. 16) GO TO 1@ 


I 1MACH=IMACH (I) 
RETURN 


16 WRITE(OUTFUT, 960¢) 
9006 FORMAT (39HLERROR 1 IN I1MACH - I OUT OF BOUNDS) 


MCHI322¢ 
MCHI324@ 
MCHI326@ 
MCHI328¢@ 
MCHI330¢ 
MCHI332@ 
MCHI334@ 
MCHI336@ 
MCHI338¢ 
MCHI346¢ 
MCHI342@ 
MCHI344¢ 
MCHI346@ 
MCHI348@ 
MCHI350@ 
MCHI352¢ 
MCHI354@ 
MCHI356@ 
MCHI358¢ 
MCHI 36060 
MCHI362¢ 
MCHI364@ 
MCHI366@ 
MCHI3686 
MCH1370@ 
MCHI372@ 
MCH1374¢ 
MCHI376@ 
MCHI378@ 
MCHI 3800 
MCHI382@ 
MCHI3840 
MCHI386¢@ 
MCHI388@ 
MCEI3900@ 
MCHI 3920 
MCHI 39490 
MCHI396¢ 
MCHI398@ 
MCHI400¢ 
MCHI462¢ 
MCHI404@ 
MCHI40660 
MCHI4068@ 
MCHI416¢ 
MCHI526@ 
MCHI528@ 
MCHI530¢ 
MCHI532@ 
MCHI5 340 
MCHI536@ 
MCHI5380) 
MCHI546@ 
MCHI542@ 
MCHI544¢ 
MCHI546¢ 
MCHI548@ 
MCHI550@ 
MCHI552¢ 
MCHI554¢ 
MCHI556@ 
MCHI5589 
MCHI56@0 
MCHI562@ 
MCHI564@ 
MCHI566¢ 
MCHI568@ 
MCHI5760 
MCHI648¢6 
MCKL6500 
MCHI652@ 
MCHI654¢6 
MCHI6560 
MCH1L658@ 
MCHL66606 
MCHI662@ 
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CALL FDUMP 
C 

STOP 
C 

END 


The function for REAL floating-point numbers is 


REAL FUNCTION R1IMACH(I) 
SINGLE-PRECISION MACHINE CONSTANTS 


RIMACH(1) 


B** (EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. 


RIMACH(2) = B**EMAX*(1 - B*¥*(-T)), THE LARGEST MAGNITUDE. 


RIMACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING. 
RIMACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING. 
RIMACH(5) = LOGI@(B) 


TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, 
THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY 
REMOVING THE C FROM COLUMN 1. 


WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED 
TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES 
REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS. 


FIRAANQNARAANAANANAANMNANANAaAANAN 


INTEGER SMALL (2) 
INTEGER LARGE (2) 
INTEGER RIGHT (2) 
INTEGER DIVER (2) 
INTEGER LOG1@(2) 


REAL RMACH(5) 


EQUIVALENCE (RMACH(1),SMALL(1)) 
EQUIVALENCE (RMACH(2) , LARGE (1)) 
EQUIVALENCE (RMACH(3),RIGHT (1) ) 
EQUIVALENCE (RMACH(4) ,DIVER(1)) 
EQUIVALENCE (RMACH(5) ,LOG1@(1)) 


MACHINE CONSTANTS FOR THE BURROUGHS 170@ SYSTEM. 


DATA RMACH(1) / 2400800600 / 
DATA RMACH(2) / Z5FFFFFFFF / 
DATA RMACH(3) / Z4E98060600 / 
DATA RMACH(4) / Z4EA80¢0000 / 
DATA RMACH(5) / Z5@Q0E73@E8 / 


DATA RMACH(1) / 01771906000000000 / 
DATA RMACH(2) / 00777777777777777 / 
DATA RMACH(3) / 01311660600060000 / 
DATA RMACH(4) / 013¢61606006000000 / 
DATA RMACH(5) / 01157163034761675 / 


MACHINE CONSTANTS FOR THE CDC 60@0/70¢0@ SERIES. 


DATA RMACH(1) / 606144606006060000600B 
DATA RMACH(2) / 37767777777777777777B 
DATA RMACH(3) / 164046¢66006006000003B 
DATA RMACH(4) / 1641460006660600000600B 
DATA RMACH(5) / 1716464202324117572@B 


—™ Me RRS 


MACHINE CONSTANTS FOR THE CRAY 1 


DATA RMACH(1) / 266004060000600000000B / 
DATA RMACH(2) / 5777777777777777777778 / 
DATA RMACH(3) / 3772146000066600000000B / 


gQaAaANnNANNANMNaAaAaNAANANMNAAAMAAMAAANAAANAANAANAANaANaNAANA 


MACHINE CONSTANTS FOR THE BURROUGHS 576¢/6700/770@ SYSTEMS. 


MCH1664@ 
MCHI666@ 
MCKI6680 
MCH1I6 760 
MCHT6720 


MCEROOOO 
MCHROO20 
MCEROO40 
MCHROM6G 
MCHROO8@ 
MCHRG160 
MCHRG126 
MCHRO14¢ 
MCHRQ160 
MCHRO18@ 
MCHRO20@ 
MCHRG220 
MCHRO24@ 
MCHRO260 
MCHRO28¢@ 
MCHRO3066 
MCHRO320 
MCHRO34¢ 
MCHRO360 
MCHRO38@ 
MCHRO400 
MCHRO420 
MCHRO44@ 
MCHRO46@ 
MCHRO48@ 
MCHRO5OG 
MCHRO52@ 
MCHRO546 
MCHRG5606 
MCHRG580 
MCERO600 
MCHR@626 
MCERG646 
MCERG660 
MCHRQ68@ 
MCHRO76¢ 
MCHR214¢ 
MCHR2166 
MCHR218¢@ 
MCHR2260 
MCHR2220 
MCHR224¢@ 
MCHR226@ 
MCHR2280 
MCHR198¢@ 
MCHR20600 
MCHR20620 
MCHR2064@ 
MCHR2@6¢ 
MCHR2@80@ 
MCHR2106@ 
MCHR212¢ 
MCHR196¢ 
MCHR1068¢ 
MCHR116¢ 
MCHR112¢@ 
MCHR114@ 
MCHR116@ 
MCHR118@ 
MCHR1206@ 
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COLLECTED ALGORITHMS (cont.) 


DATA RMACH(4) / 377224600¢60660000000B / 
DATA RMACH(5) / 377774642)23241175726B / 


AQAMQANMNAAAANAANANANAANANANAAARANANNANNANNANAANNAMAAMAANNAAMAAMAAANN AQADAAARQAAAAAAAAARAANANAANAANAANAANADWANnA 


MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/2¢¢ 


NOTE — IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - 


STATIC RMACH(5) 


DATA SMALL/2QK,@/,LARGE/77777K,177777K/ 


DATA RIGHT/35426K,@/ ,DIVER/ 36020K, @/ 


DATA LOG10/46423K, 42623K/ 


MACHINE CONSTANTS FOR THE HARRIS 226 


DATA SMALL(1),SMALL(2) / '2006400600, 
DATA LARGE(1),LARGE(2) / '37777777, 
DATA RIGHT(1),RIGHT(2) / '2606006000, 
DATA DIVER(1),DIVER(2) / '26¢60000, 
DATA 10G10(1),LOG1@(2) / '2321@115, 


MACHINE CONSTANTS FOR THE HONEYWELL 


DATA RMACH(1) / 0462404000006 / 
DATA RMACH(2) / 0376777777777 / 
DATA RMACH(3) / 0714400060066 / 
DATA RMACH(4) / 0716406000000 / 
DATA RMACH(5) / 0776464202324 / 


660006261 / 
"00000177 / 
"90000352 / 
90000353 / 
"90000377 / 


6006/6000 SERIES. 


MACHINE CONSTANTS FOR THE IBM 36@/37@ SERIES, 
THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. 


DATA RMACH(1) / 240100600 / 
DATA RMACH(2) / Z7FFFFFFF / 
DATA RMACH(3) / Z3B1000060 / 
DATA RMACH(4) / 23C160000 / 
DATA RMACK(5) / 241134413 / 


MACHINE CONSTANTS FOR THE PDP-1@ (KA OR KI PROCESSOR). 


DATA RMACH(1) / "0604060000000 / 
DATA RMACH(2) / "377777777777 / 
DATA RMACH(3) / "146440000000 / 
DATA RMACH(4) / "147460000000 / 
DATA RMACH(5) / "177464202324 / 


MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING 
32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). 


DATA SMALL(1) / 8388608 / 
DATA LARGE(1) / 2147483647 / 
DATA RIGHT(1) / 886803840 / 
DATA DIVER(1) / 889192448 / 
DATA LOG1O(1) / 1067465499 / 


DATA RMACH(1) / 060640600006 / 
DATA RMACH(2) / 017777777777 / 
DATA RMACH(3) / 0064490000060 / 
DATA RMACH(4) / 0465060660000 / 
DATA RMACH(5) / 007746420233 / 


MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING 


16-BIT INTEGERS 


(EXPRESSED IN INTEGER AND OCTAL). 


DATA SMALL(1),SMALL(2) / 128, Q / 
DATA LARGE(1),LARGE(2) / 32767, -1 / 
DATA RIGHT(1),RIGHT(2) / 13440, Q / 
DATA DIVER(1),DIVER(2) / 13568, @/ 
DATA LOG1@(1),LOG1@(2) / 16282, 8347 / 


DATA SMALL(1),SMALL(2) / 0009200, 00900009 / 
DATA LARGE(1),LARGE(2) / 0677777, 0177777 / 
DATA RIGHT(1),RIGHT(2) / 0632246, 0600000 / 
DATA DIVER(1),DIVER(2) / 0032466, 0900000 / 
DATA LOG1O(1),LOG1@(2) / 0637632, 0626233 / 


MCHR2460 
MCHR248@ 
MCHR25@0 
MCHR2520 
MCHR254@ 
MCHR2560 
MCHR2586 
MCHR2600 
MCHR2620 
MCHR264@ 
MCHR2660 
MCHR268@ 
MCHR2700 
MCHR2720¢ 
MCHR274@ 
MCHR2760 
MCHR278@ 
MCHRO72¢ 
MCHRO74@ 
MCHRO76@ 
MCHRQ7 80 
MCHRO86O 
MCHRO82¢ 
MCHRO846 
MCHRO86@ 
MCHRO88¢ 
MCHROIGG 
MCHRO92¢ 
MCHRG940 
MCHROI6@ 
MCHRO9 80 
MCHR1006@ 
MCHR1062¢ 
MCHR10646 
MCHR122¢ 
MCHR124¢ 
MCHR126¢ 
MCHR128¢ 
MCHR130¢ 
MCHR132¢ 
MCHR134¢ 
MCHR136@ 
MCHR138¢ 
MCHR140¢ 
MCHR142¢ 
MCHR144¢ 
MCHR146@ 
MCHR148¢ 
MCHR150@ 
MCHR1520 
MCHR154@ 
MCHR1L56¢@ 
MCHR158¢ 
MCHR1606¢ 
MCHR162¢ 
MCHR164@ 
MCHR166¢ 
MCHR168¢ 
MCHR1706¢ 
MCHR172¢ 
MCHR174@ 
MCHR1760 
MCHR178@ 
MCHR1806@ 
MCHR1826 
MCHR184¢ 
MCHR1860 
MCHR188¢@ 
MCHR190¢ 
MCHR1920¢ 
MCHR194@ 
MCHR196@ 
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COLLECTED ALGORITHMS (cont.) 


AAQRAARQAAANAN 


The function for DOUBLE-PRECISION floating-point numbers is 


aaqagqgaanagaagaagagaagaanaaannaananaanaa 


gaaAaNnNnananannaraanangdgaanaaanagaaanga 


MACHINE CONSTANTS FOR THE UNIVAC 11@@ SERIES. 


DATA RMACH(1) / 0660404000000 / 
DATA RMACH(2) / 0377777777777 / 
DATA RMACH(3) / 0146400000000 / 
LATA RMACH(4) / 0147400000000 / 
DATA RMACH(5) / 0177464262324 / 


TF CE... EE. PE -ZORs.. I-61 s."5) 
1 CALL SETERR(24KRIMACH - I OUT OF BOUNDS, 24,1,2) 


RIMACH = RMACH(I) 
RETURN 


END 


DOUBLE PRECISION FUNCTION D1IMACH(I) 
DOUBLE-PRECISION MACHINE CONSTANTS 


DIMACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. 


DIMACH( 2) B*¥*EMAX* (1 -— B*¥*(-T)), THE LARGEST MAGNITUDE. 


DIMACH( 3) 


B*¥*(-T), THE SMALLEST RELATIVE SPACING. 
DIMACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. 


DIMACH( 5) = LOG1@(B) 


TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, 
THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY 
REMOVING THE C FROM COLUMN l. 


WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED 
TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES 
REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS. 


INTEGER SMALL (4) 
INTEGER LARGE (4) 
INTEGER RIGHT (4) 
INTEGER DIVER(4) 
INTEGER LOGLO(4) 


DOUBLE PRECISION DMACH(5) 

EQUIVALENCE (DMACH(1),SMALL(1)) 

EQUIVALENCE (DMACH(2) ,LARGE(1)) 

EQUIVALENCE (DMACH(3) ,RIGHT(1)) 

EQUIVALENCE (DMACH(4) ,DIVER(1)) 

EQUIVALENCE (DMACH(5) ,LOG1@(1)) 

MACHINE CONSTANTS FOR THE BURROUGHS 170@ SYSTEM. 


DATA SMALL(1) / ZCGO860000 / 


DATA SMALL(2) / 20000000600 / 
DATA LARGE(1) / ZDFFFFFFFF / 
DATA LARGE(2) / ZFFFFFFFFF / 
DATA RIGHT(1) / ZCC58¢000¢ / 
DATA RIGHT(2) / 2000000000 / 
DATA DIVER(L) / ZCC6800000 / 
DATA DIVER(2) / 2600600000 / 
DATA LOG1@(L) / ZDO@E73QE7 / 
DATA LOG16(2) / zC778@@DCO / 


MACHINE CONSTANTS FOR THE BURROUGHS 57460 SYSTEM. 


DATA SMALL(1) / 017710606660600000 / 
DATA SMALL(2) / 09066060000000000 / 


MCHR2300 
MCHR232@ 
MCHR234@ 
MCHR236@ 
MCHR238@ 
MCER24066 
MCHR242@ 
MCHR244@ 
MCHR280@ 
MCHR28206 
MCHR2840 
MCHR2860 
MCHR2880 
MCHR2900 
MCHR2926 


MCHD OOOO 
MCHD6G62¢ 
MCHDOO40 
MCHDGG60 
MCHDOO8¢ 
MCHDG106¢ 
MCHDG120 
MCHD@14¢ 
MCHDG16¢ 
MCHDG18¢ 
MCHDO260 
MCHDG22¢ 
MCHDG24¢ 
MCHD@26¢ 
MCHD@28¢ 
MCHDG30¢ 
MCHD@320 
MCHDG340 
MCHDG36¢ 
MCHDO38¢ 
MCHDQ400 
MCHDO42¢ 
MCHDO446 
MCHDO46@ 
MCHDG48¢ 
MCHDG506¢ 
MCHDO520 
MCHD@540 
MCHDO56¢@ 
MCHD@58¢ 
MCHDG600 
MCHD@6 29 
MCHD (64 
MCHDG660@ 
MCHD (680 
MCHDO76¢ 
MCHD336@ 
MCHD 338 
MCHD 3406 
MCKD342@ 
MCHD344¢ 
MCHD346@ 
MCHD 3480 
MCHD3500 
MCHD352¢ 
MCHD 3546 
MCHD356@ 
MCHD3580@ 
MCHD 36060 
MCHD 3620 
MCHD364@ 
MCHD 3660 
MCHD368¢ 
MCHD3¢2¢ 
MCHD3¢4@ 
MCHD3@6¢ 
MCHD 3680 
MCHD316¢ 
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COLLECTED ALGORITHMS (cont.) 


AAQXAAAAAANRARANQANANDAAANANRANAAMAANANANANANANAANRANNANANAAANNNAMAANANAANANANAANNNANANANANANANANNAANNNAAAANAAANANANADA 


DATA LARGE (1) 
DATA LARGE (2) 


DATA RIGHT(1) 
DATA RIGHT (2) 


DATA DIVER(1) 
DATA DIVER (2) 


DATA LOG1@(1) 


‘4 
if 
/ 
/ 


/ 
/ 
/ 


00777777777777777 | 
06007777777777777 / 


01461606900000000 / 
O99GGOSGGGGGOG0GO / 


01451966600000000 / 
OD9HODDSOEOODHEOO / 


01157163034761674 / 


DATA LOG16(2) / 00006677466732724 / 


MACHINE CONSTANTS FOR THE BURROUGHS 


DATA SMALL(1) / 017719609060000000 / 
DATA SMALL(2) / 0777¢000000000000 / 


DATA LARGE(1) / 00777777777777777 
DATA LARGE(2) / 07777777777777777 


DATA RIGHT(1) / 01461600000600000 


DATA DIVER(1) / 01451¢60060000000 
DATA DIVER(2) / 066060606060000000 


j 
/ 
/ 
DATA RIGHT(2) / 09600000000000¢00 / 
/ 
jf 
/ 


DATA LOGI@(1) / 01157163634761674 


DATA LOG1¢6(2) 


/ 


00066677466732724 / 


6700/770@ SYSTEMS. 


MACHINE CONSTANTS FOR THE CDC 606¢¢/7¢@@ SERIES. 


DATA SMALL (1) 
DATA SMALL (2) 


DATA LARGE (1) 
DATA LARGE (2) 


DATA RIGHT (1) 
DATA RIGHT (2) 


DATA DIVER(1) 
DATA DIVER (2) 


DATA LOG16(1) 
DATA LOG1@(2) 


P969499SOOOOSddEOROOB / 
DOOOODSOODODGAEDOOOOB / 


377677777777777777778 
371677777777777777778 


/ 
/ 
156D4GGOSOOSSOSOOOOOB / 
15OODPOOODOODODDOOOGB / 
/ 
/ 
/ 
/ 


15614969660506006060B 
15916999006000060000B 


17164642623241175717B 
16367571421742254654B 


MACHINE CONSTANTS FOR THE CRAY 1 


DATA SMALL(1) 
DATA SMALL (2) 


DATA LARGE(1) 
DATA LARGE (2) 
DATA RIGHT(1) 
DATA RIGHT (2) 


DATA DIVER(1) 
DATA DIVER (2) 


DATA LOG1@(1) 
DATA LOG10(2) 


/ 
/ 
/ 
/ 
/ 
/ 
/ 
/ 
/ 
/ 


299994906066000000000B 
DOOOSHODHODGSOOAOOOOB / 


577777777777777777777B 
$90007777777777777777B 
377214999060006000000B 
$9ODG9D9DG9GOEOODOHOOB 


377224969900990000000B 
$999900000000000000G0R 


377774642623241175717B 
$00007571421742254654B 


MACHINE CONSTANTS FOR THE DATA GENERAL 


NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - 


STATIC DMACH(5) 


/ 


/ 
3 
/ 
/ 
/ 
/ 
f 
/ 


ECLIPSE S/26@ 


DATA SMALL/2@K, 3*6/ ,LARGE/77777K, 3*177777K/ 
DATA RIGHT/3142@K, 3*@/ ,DIVER/32@2@K, 3*0/ 
DATA L0G16/40423K, 42623K, 56237K, 74776K/ 


MACHINE CONSTANTS FOR THE HARRIS 226 


DATA SMALL(1),SMALL(2) / 120900000, 'd¢¢¢¢201 / 
DATA LARGE(1),LARGE(2) / '37777777, '37777577 / 


MCHD312¢ 
MCHD314@ 
MCHD316@ 
MCHD318¢@ 
MCHD 3200 
MCHD322@ 
MCHD324¢ 
MCHD326¢@ 
MCHD 328@ 
MCHD3306¢ 
MCHD3320 
MCHD334@ 
MCHD268@ 
MCHD276@ 
MCHD272¢ 
MCHD274@ 
MCHD276@ 
MCHD278¢@ 
MCHD280¢ 
MCHD28206 
MCHD284@ 
MCHD2860@ 
MCHD2880@ 
MCHD 29906 
MCHD292¢ 
MCHD294@ 
MCHD296@ 
MCHD298¢@ 
MCHD 2900 
MCHD 1660 
MCHD1¢'8¢ 
MCHD1106¢ 
MCHD112¢ 
MCHD114¢ 
MCHD116¢ 
MCHD118¢@ 
MCHD12¢% 
MCHD122@ 
MCHD124@ 
MCHD126¢ 
MCHD128¢@ 
MCHD 1306¢ 
MCHD132¢ 
MCHD134@ 
MCHD136@ 
MCHD138@ 


MCHD388@ 
MCHD39@@ 
MCHD 3920 
MCHD394¢ 
MCHD396¢ 
MCHD398¢ 
MCHD4060¢ 
MCHD4062¢ 
MCHD464@ 
MCHD406¢@ 


. MCHD468¢ 


MCHD4160 
MCHD412@ 
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COLLECTED ALGORITHMS (cont.) 


Cc 


NANQAANANDTANANANDANANDAANAIAANAIAARQAAAANAANMNAANDANAANAANANAANRAARAAANRAANANNANANAAMAAANNANNNANAANANaANAaANaAN 


DATA RIGHT(1),RIGHT(2) / '200006006¢, 
DATA DIVER(1),DIVER(2) / '206000600, 
DATA LOG1@(1),LOG10(2) / '23219@115, 


MACHINE CONSTANTS FOR THE HONEYWELL 


DATA SMALL(1),SMALL(2) / 0442400600000, 
DATA LARGE(1),LARGE(2) / 0376777777777, 
DATA RIGHT(1),RIGHT(2) / 0664400600000, 
DATA DIVER(1),DIVER(2) / 0646406600000, 
DATA LOG1@(1),LOG16(2) / 0776464202324, 


'$0000333 / 
"90000334 / 
"19237777 / 


6006/6000 SERIES. 


099999000000 
0777777777777 
0990990000000 
0990098000000 
0117571775714 


MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, 
THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. 


DATA SMALL(1),SMALL(2) / 200160000, 
DATA LARGE(1),LARGE(2) / Z7FFFFFFF, 
DATA RIGHT(1),RIGHT(2) / 233100000, 
DATA DIVER(1) ,DIVER(2) / 234160000, 
DATA LOG1@(1),LOG1@(2) / 241134413, 


ZOOOOOOGY / 
ZFFFFFFFF / 
ZOOOOOOOD / 
ZOOOOOOOO / 
Z5QO9F79FF / 


MACHINE CONSTANTS FOR THE PDP-1@ (KA PROCESSOR). 


DATA SMALL(1),SMALL(2) / 
DATA LARGE(1),LARGE(2) / 
DATA RIGHT(1),RIGHT(2) / 
DATA DIVER(1),DIVER(2) / 
DATA LOG1@(1),LOG1@(2) / 


"933490060000, 
MOITTTITIIILTT 
"113460000000, 
"114499060000, 
"177464262324, 


"099900000000 
"344777777777 
"099900900000 
"699000000000 
"144117571776 


MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). 


DATA SMALL(1),SMALL(2) / 
DATA LARGE(1),LARGE(2) / 
DATA RIGHT(1),RIGHT(2) / 
DATA DIVER(1) ,DIVER(2) / 
DATA LOG1G(1),LOG1G(2) / 


"660490000000, 
"377777777777, 
"163404600000, 
"164400000000, 
"177464262324, 


"699060000000 
"377777777777 
"900990000000 
"99000000000 
"476747767461 


MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING 
32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). 


DATA 
DATA 
DATA 
DATA 
DATA 


DATA 
DATA 
DATA 
DATA 
DATA 


SMALL (1) , SMALL (2) 
LARGE (1) , LARGE (2) 
RIGHT (1) , RIGHT (2) 
DIVER(1) ,DIVER (2) 
LOG1@(1) ,LOG1@(2) 


SMALL (1) , SMALL (2) 
LARGE (1) , LARGE (2) 
RIGHT (1) ,RIGHT (2) 
DIVER(1) ,DIVER (2) 
LOG1G(1) ,LOG1@(2) 


/ 
/ 
/ 
/ 
/ 


/ 
/ 
/ 
/ 
/ 


8388608, 
2147483647, 
612368384, 
620756992, 
1067965498, 


099046900000, 
017777777777, 
094446000000, 
094590000000, 
0067746420232, 


MACHINE CONSTANTS FOR PDP-11 FORTRAN'S 
16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). 


DATA 
DATA 


DATA 
DATA 


DATA 
DATA 


DATA 
DATA 


DATA 
DATA 


DATA 
DATA 


DATA 
DATA 


SMALL (1) , SMALL(2) 
SMALL (3) , SMALL (4) 


LARGE (1) , LARGE (2) 
LARGE (3) , LARGE (4) 


RIGHT (1) , RIGHT (2) 
RIGET (3) ,RIGHT (4) 


DIVER(1) ,DIVER(2) 
DIVER(3) ,DIVER (4) 


LOG1@(1) ,LOG1@6(2) 
LOG1@¢(3) ,LOG1@(4) 


SMALL (1), SMALL (2) 
SMALL (3) , SMALL (4) 


LARGE (1) , LARGE (2) 
LARGE (3) , LARGE (4) 


/ 


/ 
/ 
/ 
/ 
/ 
/ 
/ 
i 
/ 


~206387 200 


0 / 
aS ee 

/ 
O/ 
Bay 


0969606000000 / 
037777777777 / 
0990606600000 / 
0946600060000 / 
026476747776 / 


SUPPORTING 


128, ¢ / 
%, o / 
32767, -1 / 
=i, -1 / 
9344, @ / 
%, o/ 
9472, @/ 
0, o / 
16282, 8346 / 


-31493, -12296 / 


/ 0090266, 0666660 / 
/ 0990000, 0600000 / 


/ 0077777, 0177777 / 
/ 0177777, 0177777 / 


~ RR 


MCHD414@ 
MCHD416@ 
MCHD418@ 


MCHDG72¢ 
MCHDO74@ 
MCHDO76@ 
MCHD@780@ 
MCHDG800 
MCHDO8 20 
MCHDG84¢ 
MCHD@86@ 
MCHDG88¢ 
MCHDG9G@ 
MCHDG92@ 
MCHDQ9406 
MCHD6960@ 
MCHDO980 
MCHD 146060 
MCHD1¢2@ 
MCHD 1940 
MCHD 1460 
MCHD142¢ 
MCHD144@ 
MCHD1460@ 
MCHD148@ 
MCHD150¢ 
MCHD1520@ 
MCHD154@ 
MCHD156@ 
MCHD158@ 
MCHD16060 
MCHD162@ 
MCHD164@ 
MCHD 1660 
MCHD168@ 
MCHD1700 
MCHD172¢ 
MCHD174@ 
MCHD176@ 
MCHD1780@ 
MCHD 1800 
MCHD182@ 
MCHD184@ 
MCHD186@ 
MCHD188@ 
MCHD 1900 
MCHD192¢ 
MCHD194@ 
MCHD196@ 
MCHD 198¢ 
MCHD20600 
MCHD262@ 
MCHD20640 
MCHD206@ 
MCHD2068@ 


- MCHD210¢ 


MCHD212¢ 
MCHD214@ 
MCHD216¢@ 
MCHD218¢@ 
MCHD2200 
MCHD222¢ 
MCHD2 246 
MCHD2 260 
MCHD228¢ 
MCHD236¢ 
MCHD2 320 
MCHD234@ 
MCED2 360 
MCHD2 380 
MCHD2406¢ 
MCHD242¢ 
MCHD244@ 
MCHD2460@ 
MCHD248@ 
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c DATA RIGHT(1),RIGHT(2) / 0622204, 0606000 / MCHD256¢ 
Cc DATA RIGHT(3),RIGHT(4) / 0640006, 0606000 / MCHD2520 
Cc MCHD254¢ 
C DATA DIVER(1),DIVER(2) / 0022466, 0600000 / MCHD256@ 
C DATA DIVER(3) ,DIVER(4) / 0600006, 0600006 / MCHD2580 
Cc MCHD266¢ 
Cc DATA LOG10(1),L0G1¢(2) / 0637632, 0620232 / MCHD2620@ 
Cc DATA LOG16(3),L0G16(4) / 0162373, 0147770 / MCHD264@ 
Cc MCHD266@ 
Cc MACHINE CONSTANTS FOR THE UNIVAC 11@@ SERIES. MCHD376@ 
Cc MCHD372@ 
Cc DATA SMALL(1),SMALL(2) / 0660040066000, 06066460060000 / MCHD 3740 
Cc DATA LARGE(1),LARGE(2) / 0377777777777, 0777777777777 / MCHD3760 
Cc DATA RIGHT(1) ,RIGHT(2) / 0170546000600, ODDOOODOHOGED / MCHD378¢ 
Cc DATA DIVER(1),DIVER(2) / 0176646090000, 0400000000000 / MCHD380¢ 
Cc DATA LOG1@(1),LOG1@(2) / 0177746420232, 0411757177572 / MCHD3820 
C MCHD 3860 
Cc MCHD426@ 

TPL: sET eT sORs. -Y .GTs 5) MCHD422@ 

1 CALL SETERR(24HDIMACH - I OUT OF BOUNDS, 24,1, 2) MCHD424@ 
Cc MCHD426@ 

DIMACH = DMACH(I) MCHD428@ 

RETURN MCHD430@ 
Cc MCHD432@ 

END MCHD434@ 


Automatic Error Handling 


The second package provides a basic mechanism for dealing with the occurrence 
of errors. 

In the PORT library [1], for which the package was developed, calls to the 
general subroutines in the library do not. include flags for error indication in their 
calling sequences. Instead, when a called subroutine detects an error, it calls the 
principal error-handling routine, SETERR. 

The package allows for two types of error, “fatal,” and “recoverable,” and a 
parameter in the call to SETERR must be set to specify the type. Fatal errors 
cause an error message to be printed, the run terminated, and a call made to a 
dump routine. (A dummy dump routine, FOUMP, is provided here.) For recover- 
able errors, unless the user has specifically requested to enter the recovery mode, 
similar events occur, an error message is printed, and the run terminated. Thus 
the process is failsafe for unwary users. 

When the recovery mode is in effect, any call to SETERR given within a 
subprogram which has detected a recoverable error has the effect only of storing 
the fact that an error has occurred; the run is not terminated. The user, upon 
return from the subprogram, is responsible for testing for the occurrence of an 
error. If an error has occurred, the user must turn off the error state, because 
additional errors might arise and the occurrence of a recoverable error while in 
the error state constitutes an unrecoverable error, terminating the run. 

Finally, since a called subprogram, say SUBA, may, in turn, call a lower-level 
subprogram containing recoverable errors, SUBA must check for the occurrence 
of errors in the lower-level routine and reinterpret them in the context of SUBA, 
which the user knows about. This means that SUBA must enter the recovery 
mode (saving the mode previously in effect), make the call to the lower-level 
subprogram, then, upon return from the lower-level routine, check for errors, and, 
before returning to the user, restore the previous recovery mode. 

An error which has caused an invocation of SETERR has an associated 
number, message, and type (fatal or recoverable), and the effect of the error 
depends on whether the recovery mode is in effect or not. The various capabilities 
offered in the subprograms of the package are summarized as follows. 


To signal that an error has occurred: 
CALL SETERR(MESSG, NMESSG, NERR, IOPT) 


528-P12- 


0 


COLLECTED ALGORITHMS (cont.) 528-P13- 0 


where MESSG and NMESSG are, respectively, a Hollerith message and the 
number of characters in the message, and NERR is the error number. IOPT is 
used to specify the type of error: IOPT = 1 for a recoverable error, and IOPT = 
2 for a fatal error. 


To save the recovery (or nonrecovery) mode currently in effect, and enter a 
new one: 


CALL ENTSRC(IROLD, IRNEW) 
which saves the current mode in IROLD and sets the new one to IRNEW. 


To avoid having multiple errors outstanding, it is a fatal error to call SETERR 
or ENTSRC if the error state is on, meaning that an error has occurred but has 
not been recovered from. 


To restore the recovery (or nonrecovery) mode which was previously saved in 
IROLD: 


CALL RETSRC(IROLD) 


where RETSRC not only restores the previous mode, but also acts as a “safety” 
exit gate: Since multiple errors are illegal, RETSRC checks out the situation and 
allows return to the calling program only if (1) an error is not outstanding, or (2) 
the restored mode is recovery, so that the calling program is responsible for error 
checking. 


To test if an error has occurred, and if its number was, say, 4, a statement such 
as the following is used: 


IF (NERROR(NERR) .EQ. 4) GO TO 50 


The value of the function NERROR and the value of the argument NERR are 
both set to the current value of the error number by NERROR. (The double 
assignment may be useful and comes free since Fortran prohibits functions with 
no arguments.) If the error number is nonzero, it means that an error has occurred 
and that corrective action must be taken. 


To turn off the error state: 
CALL ERROFF 


In summary the user subprograms are: 


SETERR _ turns on the error state and saves a message and an error number; 

ENTSRC _ at entry, sets recovery (or nonrecovery) mode, provided no error 
state exists; 

RETSRC _ before returning, checks error situation and, if no errors exist, 
restores prior recovery (or nonrecovery) mode; 

NERROR returns the error number; 

ERROFF _ turns off the error state; 

EPRINT prints the error message. 


These, in turn, call on the lower-level subprograms: 


E9RINT stores or prints error message, depending on switch setting; 
S88FMT sets up FORMAT array for printing; 


I8SAVE _ returns error number or recovery (or nonrecovery) mode, depending 
on one switch, and resets or does not reset the corresponding value 
depending on another; 

FDUMP a dummy routine to be replaced, if possible, by a locally written 
symbolic dump routine. 
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C 
C THE UNIT FOR ERROR MESSAGES. 
Cc 
IWUNIT=I1MACH (4) 
Cc 
IF (NMESSG.GE.1) GO TO 1¢ 
¢C 
C A MESSAGE OF NON-POSITIVE LENGTH IS FATAL. 
Cc 
WRITE (LWUNIT, 9000) 
9¢¢@ FORMAT(52HIERROR 1 IN SETERR - MESSAGE LENGTH NOT POSITIVE.) 
GO TO 60 
C 
C NW IS THE NUMBER OF WORDS THE MESSAGE OCCUPIES. 
Cc 
16  NW=(MIN@(NMESSG, 72)-1)/I1MACH(6)+1 
Cc 
IF (NERR.NE.@) GO TO 2¢ 
C 
C CANNOT TURN THE ERROR STATE OFF USING SETERR. 
Cc 
WRITE (IWUNIT, 9001) 
9901 FORMAT(42H1ERROR 2 IN SETERR - CANNOT HAVE NERR=(// 
1 34H THE CURRENT ERROR MESSAGE FOLLOWS///') 
CALL EQRINT (MESSG,NW,NERR, . TRUE.) 
ITEMP=L8SAVE (1,1, . TRUE.) 
GO TO 5@ 
Cc 
C SET LERROR AND TEST FOR A PREVIOUS UNRECOVERED ERROR. 
Cc 
2@ IF (I8SAVE(1,NERR,.TRUE.).EQ.¢) GO TO 3¢ 
Cc 
WRITE (IWUNIT, 9602) 
96¢2 FORMAT(23HIERROR 3 IN SETERR -, 
i 48H AN UNRECOVERED ERROR FOLLOWED BY ANOTHER ERROR.// 
2 48H THE PREVIOUS AND CURRENT ERROR MESSAGES FOLLOW.///) 
CALL EPRINT 
CALL E9RINT(MESSG,NW,NERR, . TRUE.) 
GO TO 5¢ 
Cc 


SUBROUTINE SETERR (MESSG, NMESSG, NERR, IOPT) 


SETERR SETS LERROR = NERR, OPTIONALLY PRINTS THE MESSAGE AND DUMPS 


ACCORDING TO THE FOLLOWING RULES... 
IF IOPT = 1 AND RECOVERING ~ JUST REMEMBER THE ERROR. 
IF IOPT = 1 AND NOT RECOVERING - PRINT AND STOP. 
IF IOPT = 2 - PRINT, DUMP AND STOP. 
INPUT 
MESSG - THE ERROR MESSAGE. 
NMESSG - THE LENGTH OF THE MESSAGE, IN CHARACTERS. 
NERR -—- THE ERROR NUMBER. MUST HAVE NERR NON-ZERO. 
IOPT —- THE OPTION. MUST HAVE IOPT=1 OR 2. 
ERROR STATES - 
1 - MESSAGE LENGTH NOT POSITIVE. 
2 - CANNOT HAVE NERR=@. 
3 - AN UNRECOVERED ERROR FOLLOWED BY ANOTHER ERROR. 
4 - BAD VALUE FOR IOPT. 


ONLY THE FIRST 72 CHARACTERS OF THE MESSAGE ARE PRINTED. 


THE ERROR HANDLER CALLS A SUBROUTINE NAMED FDUMP TO PRODUCE A 
SYMBOLIC DUMP. TO COMPLETE THE PACKAGE, A DUMMY VERSION OF FDUMP 


IS SUPPLIED, BUT IT SHOULD BE REPLACED BY A LOCALLY WRITTEN VERSION 


WHICH AT LEAST GIVES A TRACE-BACK. 


INTEGER MESSG(1) 


C SAVE THIS MESSAGE IN CASE IT IS NOT RECOVERED FROM PROPERLY. 


ERRSOOOO 
ERRSOO2¢ 
ERRS@O4¢ 
ERRSGOEG 
ERRSOO8O 
ERRS@10¢ 
ERRS@12@ 
ERRS@140 
ERRSG16@ 
ERRS@18¢@ 
ERRS@260 
ERRS@220 
ERRS@246 
ERRSO26¢ 
ERRS@28@ 
ERRSO360 
ERRS@326 
ERRSO34¢ 
ERRS@36¢ 
ERRS@38@ 
ERRSO40@ 
ERRS@42¢@ 
ERRSO446 
ERRSG46¢ 
ERRSO48¢ 
ERRSO500 
ERRS52@ 
ERRS@540 
ERRS@560 
ERRS@5806 
ERRSG600 
ERRS@620 
ERRS@64@ 
ERRSO660 
ERRSG@68¢ 
ERRSO700 
ERRSO72¢ 
ERRS@74@ 
ERRS@760 
ERRS@78@ 
ERRSO8OO 
ERRS@820 
ERRS@846 
ERRS@86¢@ 
ERRS@88@ 
ERRSO9OG 
ERRS@92¢ 
ERRSG940 
ERRS#960 
ERRSG98@ 
ERRS 1000 
ERRS10626 
ERRS1064@ 
ERRS166¢ 
ERRS108¢ 
ERRS1100 
ERRS112¢ 
ERRS1140 
ERRS 1160 
ERRS118@ 
ERRS1200 
ERRS122@ 
ERRS124@ 
ERRS126@ 
ERRS1280 
ERRS 1300 
ERRS132@ 
ERRS134@ 
ERRS136@ 
ERRS138@ 
ERRS146¢ 
ERRS1426 
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C 


C 


aan 


C 
C 
C 


¢ 


AQANQARAARAANAAAAANN 


aaa 


AP raaaniraan 


O04 


3@ CALL EQRINT(MESSG,NW,NERR, .TRUE.) 
IF (IOPT.EQ.1 .OR. IOPT.EQ.2) GO TO 4¢ 
MUST HAVE IOPT = 1 OR 2. 
WRITE (IWUNIT , 9403) 
9403 FORMAT (42H1ERROR 4 IN SETERR - BAD VALUE FOR IOPT// 
1 34H THE CURRENT ERROR MESSAGE FOLLOWS///) 
GO TO 5@ 
TEST FOR RECOVERY. 
46 IF (IOPT.EQ.2) GO TO 5¢ 
IF (I8SAVE(2,@,.FALSE.).EQ.1) RETURN 
CALL EPRINT 
STOP 


5@ CALL EPRINT 
60 CALL FDUMP 
STOP 


END 


SUBROUTINE ENTSRC (IROLD, IRNEW) 
THIS ROUTINE RETURNS IROLD = LRECOV AND SETS LRECOV = IRNEW. 


IF TRERE IS AN ACTIVE ERROR STATE, THE MESSAGE IS PRINTED 
AND EXECUTION STOPS. 


IRNEW 
IRNEW 
IRNEW 


@ LEAVES LRECOV UNCHANGED, WHILE 
1 GIVES RECOVERY AND 
2 TURNS RECOVERY OFF. 


ERROR STATES - 


1 - ILLEGAL VALUE OF IRNEW. 
2 - CALLED WHILE IN AN ERROR STATE. 


IF (IRNEW.LT.@ .OR. IRNEW.GT.2) : 
1 CALL SETERR(31HENTSRC - ILLEGAL VALUE OF IRNEW,31,1,2) 


IROLD=I8SAVE(2, IRNEW, IRNEW.NE.@) 
IF HAVE AN ERROR STATE, STOP EXECUTION. 


IF (I8SAVE(1,@,.FALSE.) .NE. $) CALL SETERR 
1 (39HENTSRC - CALLED WHILE IN AN ERROR STATE, 39,2, 2) 


RETURN 


END 


SUBROUTINE RETSRC (IROLD) 
THIS ROUTINE SETS LRECOV = IROLD. 


IF THE CURRENT ERROR BECOMES UNRECOVERABLE, 
THE MESSAGE IS PRINTED AND EXECUTION STOPS. 


ERROR STATES - 
1 - ILLEGAL VALUE OF IROLD. 


IF (IROLD.LT.1 .OR. IROLD.GT.2) 
1 CALL SETERR(31HRETSRC - ILLEGAL VALUE OF IROLD,31,1,2) 


ITEMP=I8SAVE(2, IROLD, . TRUE.) 


IF THE CURRENT ERROR IS NOW UNRECOVERABLE, PRINT AND STOP. 


ERRS1446 
ERRS146@ 
ERRS148@ 
ERRS150¢ 
ERRS1520 
ERRS154@ 
ERRS156@ 
ERRS158@ 
ERRS1606¢ 
ERRS1620 
ERRS164@ 
ERRS166@ 
ERRS168@ 
ERRS17@@ 
ERRS172@ 
ERRS174@ 
ERRS176@ 
ERRS1780@ 
ERRS1800 
ERRS182@ 
ERRS184@ 
ERRS186@ 
ERRS188@ 
ERRS190@ 
ERRS1920 
ERRS194@ 


RECAGGOG 
RECAGG2¢ 
RECAOO46 
RECAGG60 
RECAG@8@ 
RECAG10@ 
RECAO120 
RECAG14@ 
RECAG160 
RECAG18¢ 
RECAG200 
RECA@220 
RECA@24@ 
RECAO26@ 
RECAQ28¢ 
RECAO30@ 
RECAG32¢ 
RECAQ34@ 
RECAQ36@ 
RECAG38@ 
RECAQ40@ 
RECAQ420 
RECAQG4406 
RECAO4606 
RECAQO486 
RECAQ56¢ 
RECAO52@ 
RECA@54@ 
RECAG56@ 


RECBGO0@ 
RECB9G20 
RECBOG40 
RECBOQ60 
RECBQ@80 
RECBO10¢ 
RECBQ#120 
RECBO1L4@ 
RECBO16@ 
RECB@18@ 
RECBO20@ 
RECBO22@ 
RECBO24@ 
RECBO26@ 
RECBQ28¢ 
RECBO30@ 
RECBG32@ 
RECBO340@ 
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aa aaa 


aa 


aanaana 


QNAAAN ANA AaNnNaNnAA 


Q 


IF (IROLD.EQ.1 .OR. I8SAVE(1,0, .FALSE.).EQ.@) RETURN 


CALL EPRINT 
STOP 


END 


INTEGER FUNCTION NERROR (NERR) 
RETURNS NERROR = NERR = THE VALUE OF THE ERROR FLAG LERROR. 
NERROR=L8SAVE (1,@, . FALSE. > 
NERR=NERROR 
RETURN 


END 


SUBROUTINE ERROFF 
TURNS OFF THE ERROR STATE OFF BY SETTING LERROR=@. 


I=I8SAVE (1,0, . TRUE.) 
RETURN 


END 


SUBROUTINE EPRINT 
THIS SUBROUTINE PRINIS THE LAST ERROR MESSAGE, IF ANY. 
INTEGER MESSG(1) 


CALL EQRINT(MESSG,1,1, .FALSE.) 
RETURN 


END 


SUBROUTINE EQRINT (MESSG, NW, NERR, SAVE) 


THIS ROUTINE STORES THE CURRENT ERROR MESSAGE OR PRINTS THE OLD ONE, 
IF ANY, DEPENDING ON WHETHER OR NOT SAVE = .TRUE. 


INTEGER MESSG (NW) 
LOGICAL SAVE 


MESSGP STORES AT LEAST THE FIRST 72 CHARACTERS OF THE PREVIOUS 
MESSAGE. ITS LENGTH IS MACHINE DEPENDENT AND MUST BE AT LEAST 


1 + 71/(THE NUMBER OF CHARACTERS STORED PER INTEGER WORD). 
INTEGER MESSGP (36) ,FMT(14) ,CCPLUS 
START WITH NO PREVIOUS MESSAGE. 
DATA MESSGP(J)/1H1/, NWP/@/, NERRP/@/ 


SET UP THE FORMAT FOR PRINTING THE ERROR MESSAGE. 
THE FORMAT IS SIMPLY (Al, 14X,72AXX) WHERE XX=I1MACH(6) IS THE 
NUMBER OF CHARACTERS STORED PER INTEGER WORD. 

DATA CCPLUS / 1H+ / 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 


~ 
> 
ww 
~ ™ 
—y 
m 
we 
“~~ Mm. Mm TM TM OS 


RECBO36@ 
RECBG38¢@ 
RECBO400 
RECBQ420 
RECBO446 
RECBO46@ 


ERRNOOOD 
ERRNGO206 
ERRNGO4@ 
ERRNOG6O 
ERRNGO8@ 
ERRNG160 
ERRN@12@ 
ERRN@14¢ 
ERRN@16@ 


ERRF OOOO 
ERRFOO2¢ 
ERRFOO4@ 
ERRFVG60 
ERRFOO8@ 
ERRFO1060 
ERRF@12¢ 
ERRFO14@ 


ERRP OOOO 
ERRPOG26 
ERRPOO4@ 
ERRPOOG6@ 
ERRPOO8O 
ERRPG100 
ERRP@12@ 
ERRPO14@ 
ERRPO16@ 
ERRPG18@ 


ERRROOOD 
ERRROO20 
ERRROO4O 
ERRROG6@ 
ERRROO8O 
ERRRO10¢ 
ERRRO12¢ 
ERRRG14@ 
ERRRG16¢ 
ERRRQO18¢ 
ERRRO200 
ERRRO220 
ERRRO246 
ERRRO260 
ERRRO28@ 
ERRRO300 
ERRRO320 
ERRRG34@ 
ERRRO360 
ERRRO38@ 
ERRRO4OO 
ERRRO4 26 
ERRRO44O 
ERRRO460 
ERRRO486 
ERRRO506¢ 
ERRRO520 
ERRRG54@ 
ERRRO56@ 
ERRRG58@ 
ERRRG600 
ERRRG620 
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DATA FMT( 8) / 1H, / 


aqaaa 


1¢ 
C 


C 
20 
Cc 


DATA FMT( 9) / 1H7 / 
DATA FMT(10) / 1H2 / 
DATA FMT(11) / 1HA / 
DATA FMT(12) / 1BX / 
DATA FMT(13) / 1HX / 
DATA FMT(14) / 1H) / 
IF (.NOT.SAVE) GO TO 2¢ 
SAVE THE MESSAGE, 

NWP=NW 

NERRP=NERR 

DO 1¢ I=1,NW 

MESSGP (1)#MESSG (I) 

GO TO 3¢ 
IF (I8SAVE(1,@,.FALSE.).EQ.@) GO TO 3¢ 


C PRINT THE MESSAGE. 


3¢ 


AaAAAND 


io) 


16 


RE 


IWUNIT=11MACH (4) 
WRITE (IWUNIT, 9606) NERRP 
FORMAT(7H ERROR ,14,4H IN ) 


CALL S88FMT (2, I1MACH(6) , FMT (12) ) 
WRITE (IWUNIT,FMT) CCPLUS, (MESSGP (I) ,I=1,NWP) 


TURN 


END 


SU 


S88FMIT REPLACES IFMT(1), ... 


THE C 
DIGIT 


BROUTINE S88FMT( N, W, IFMT ) 


, IFMT(N) WITH 
HARACTERS CORRESPONDING TO TEE N LEAST SIGNIFICANT 
S OF W. 


INTEGER N,W, IFMT (N) 


INTEGER NI,WT,DIGITS (1¢) 


DATA DIGITS( 1) / 1k@ / 
DATA DIGITS( 2) / 1H1 / 
DATA DIGITS( 3) / 1H2 / 
DATA DIGITS( 4) / 183 / 
DATA DIGITS( 5) / 184 / 
DATA DIGITS( 6) / 1H5 / 
DATA DIGITS( 7) / 1H6 / 
DATA DIGITS( 8) / 1H7 / 
DATA DIGITS( 9) / 1H8 / 
DATA DIGITS(1¢) / 189 / 
NT = N 

WI = W 

‘IF (NT .LE. $6) RETURN 


EN 


IDIGIT = MOD( WT, 1@ ) 
IFMT(NT) = DIGITS (IDIGIT+1) 
WI = WT/10 

NI = NT - 1 

GO TO 1¢ 


D 


INTEGER FUNCTION I8SAVE(ISW, IVALUE, SET) 


C 

C IF (ISW = 1) ISSAVE RETURNS THE CURRENT ERROR NUMBER AND 

C SETS IT TO IVALUE IF SET = .TRUE. . 

C 

C IF (ISW = 2) I8SAVE RETURNS THE CURRENT RECOVERY SWITCH AND 
C SETS IT TO IVALUE IF SET = .TRUE. 


ERRRG640 
ERRRG66@ 
ERRRO680 
ERRRO7060 
ERRRO72@ 
ERRRQ740 
ERRRO76@ 
ERRRQ7 80 
ERRRO8OO 
ERRRO8 26 
ERRRO84¢ 
ERRR@860 
ERRRO880 
ERRRG9G6O 
ERRRG9 20 
ERRRG9I 4G 
ERRRO960 
ERRRG98@ 
ERRR1OO@ 
ERRR162¢ 
ERRR1064@ 
ERRR196@ 
ERRR1O80 
ERRR116¢ 
ERRR112@ 
ERRR114@ 
ERRR116@ 
ERRR118¢ 
ERRR12¢¢ 
ERRR1220 
ERRR124@ 
ERRR1 260 
ERRR1286 


ERRMOOO0 
ERRMOO2@ 
ERRMO040 
ERRMOG6@ 
ERRMOO68@ 
ERRMO160 
ERRMO120 
ERRMG14@ 
ERRM@160 
ERRMO18¢ 
ERRMO200 
ERRM6220 
ERRMG246 
ERRM@260 
ERRM@ 280 
ERRMO 300 
ERRMO32@ 
ERRMO34@ 
ERRM$@ 360 
ERRMO 380 
ERRMO400 
ERRMQ4 20 
ERRMO440 
ERRMO46@ 
ERRMQ480 
ERRMO5060 
ERRM@520 
ERRMO546 
ERRMQ56¢ 
ERRM@58@ 
ERRMG600 
ERRMG6 20 


ERRVGOOO 
ERRVO0206 
ERRVOG40 
ERRVOG60 
ERRVGG8@ 
ERRVO160 
ERRV@12@ 
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C ERRV@14@ 
LOGICAL SET ERRV@16@ 
C ERRVG18¢ 
INTEGER IPARAM(2) ERRVO200 
EQUIVALENCE (IPARAM(1),LERROR) , (IPARAM(2) , RECOV) ERRVO220 
re ERRVQ240 
C START EXECUTION ERROR FREE AND WITH RECOVERY TURNED OFF. ERRVO266 
Cc ERRV@28¢ 
DATA LERROR/@/ , LRECOV/2/ ERRVO300 
Cc ERRVO320 
I8SAVE=IPARAM (ISW) ERRVO340 
IF (SET) IPARAM(ISW)=LVALUE ERRVO360 
Cc ERRVO38@ 
RETURN ERRVO40@ 
C ERRVO4 20 
END ERRVO44@ 
e Y 
SUBROUTINE FDUMP FDMP 0000 
C THIS IS A DUMMY ROUTINE TO BE SENT OUT ON FDMP@062@ 
C THE PORT SEDIT TAPE FDMP 0040 
Cc FDMPOG6¢ 
RETURN FDMPO08¢ 
END FDMP@ 100 


Dynamic Storage Allocation Using a Stack 


The third package provides a basic mechanism for allocating and deallocating 
working storage on a storage stack. 

In the PORT library [1], for which the package was developed, calls to the 
general subroutines in the library do not include, in their calling sequences, 
parameters representing scratch arrays; the work space is allocated and deallo- 
cated within the called subprograms. 

To implement the stack in Fortran in a poystable way, it has been put in labeled 
COMMON as a double-precision array of length 500: 


COMMON/CSTAK/DSTAK(500) 
DOUBLE PRECISION DSTAK 


The stack handling capabilities, which are described more fully in [1], include 
stack allocation and deallocation (releasing space), stack initialization to a size 
different from the default length of 500 double-precision locations, stack query, 
i.e. the ability to find out dynamically how much space is available, modification 
of the length of the latest allocation, and finally, the ability to ascertain certain 
stack statistics, such as the number of outstanding allocations, the current active 
length, and the maximum active length achieved. 
The various capabilities are summarized as follows: 


To allocate (get) N locations of type ITYPE on the stack, set 
INDEX = ISTKGT(N, ITYPE) 
which returns an index into the stack for the first of the N items. 


To deallocate (release) the last K allocations (not locations but entire alloca- 
tions): 
CALL ISTKRL(K) 


To initialize the stack to, say, 1000 double-precision locations, use the subrou- 
tine, ISTKIN(N, ITYPE), as follows: 


COMMON/CSTAK/DSTAK(1000) 
DOUBLE PRECISION DSTAK 


CALL ISTKIN(1000, 4) 


COLLECTED ALGORITHMS (cont.) 


To find out (query) how much space of type, ITYPE, is left: 


NLEFT = ISTKQU(ITYPE) 


To modify the length of the current outstanding allocation to N items: 
INDEX = ISTKMD(N) 


which will modify the length of the allocation to N items and, as in ISTKGT, 
return the index of the first item of that allocation. 


To obtain certain stack statistics use the 


INTEGER FUNCTION ISTKST(N) 


In summary the user subprograms are: 


ISTKGT allocates space on the stack; 

ISTKRL _ releases (deallocates) space; 

ISTKIN initializes (sets length) of stack; 

ISTKQU answers query as to space available on stack; 
ISTKMD modifies length of current allocation; 
ISTKST _ provides statistics on stack usage. 


These, in turn, call on the lower-level subprogram: 


I0OTKOO 
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INTEGER FUNCTION ESTKGT(NITEMS, ITYPE) 


ALLOCATES SPACE OUT OF THE INTEGER ARRAY ISTAK (IN COMMON 
BLOCK CSTAK) FOR AN ARRAY OF LENGTH NITEMS AND OF TYPE 
DETERMINED BY IT¥PE AS FOLLOWS 


LOGICAL 

- INTEGER 

- REAL 

~ DOUBLE PRECISION 
- COMPLEX 


UB WN Ee 


ON RETURN, THE ARRAY WILL OCCUPY 


STAK(ISTKGT), STAK(ISTKGT+1), ..., STAK(ISTKGT-NITEMS+1) 


WHERE STAK IS AN ARRAY OF TYPE LTYPE EQUIVALENCED TO ISTAK. 


(FOR THOSE WANTING TO MAKE MACHINE DEPENDENT MODIFICATIONS 
TO SUPPORT OTHER TYPES, CODES 6,7,8,9,1@,11 AND 12 HAVE 
BEEN RESERVED FOR 1/4 LOGICAL, 1/2 LOGICAL, 1/4 INTEGER, 
1/2 INTEGER, QUAD PRECISION, DOUBLE COMPLEX AND QUAD 
COMPLEX, RESPECTIVELY.) 


THE ALLOCATOR RESERVES THE FIRST TEN INTEGER WORDS OF THE STACK 
FOR ITS OWN INTERNAL BOOK-KEEPING. THESE ARF INITIALIZED BY 

THE INITIALIZING SUBPROGRAM I@¢TK@@ UPON THE FIRST CALL 

TO A SUBPROGRAM IN THE ALLOCATION PACKAGE. 


THE USE OF THE FIRST FIVE WORDS IS DESCRIBED BELOW. 


ISTAK( 1) - LOUT, THE NUMBER OF CURRENT ALLOCATIONS. 
ISTAK( 2) - LNOW, THE CURRENT ACTIVE LENGTH OF THE STACK. 
ISTAK( 3) - LUSED, THE MAXIMUM VALUE OF ISTAK(2) ACHIEVED. 
ISTAK( 4) - LMAX, THE MAXIMUM LENGTH THE STACK. 

ISTAK( 5) - LBOOK, THE NUMBER OF WORDS USED FOR BOOKEEPING. 


THE NEXT FIVE WORDS CONTAIN INTEGERS DESCRIBING THE AMOUNT 
OF STORAGE ALLOCATED BY. THE FORTRAN SYSTEM TO THE VARIOUS 
DATA TYPES. THE UNIT OF MEASUREMENT IS ARBITRARY AND MAY 
BE WORDS, BYTES OR BITS OR WHATEVER IS CONVENIENT. THE 


initializes stack for special cases of nonstandard lengths for IN- 
TEGER, REAL, and DOUBLE PRECISION numbers. 


STKEOOOO 
STKEGO2¢6 
STKEGO4@ 
STKEQG66 
STKE@O8@ 
STKEG100 
STKEG12¢ 
STKE@14@ 
STKE@16¢ 
STKE@18@ 
STKEG 2060 
STKE@22@ 
STKEG24@ 
STKE®26@ 
STKE@28@ 
STKEQ300@ 
STKE@3206 
STKEG340 
STKEG360 
STKEQ380 
STKEG4060 
STKEG420 
STKEQ44@ 
STKEO460 
STKE@480 
STKE@560 
STKEG52@ 
STKEO54@ 
STKEO56¢ 
STKE@58@ 
STKEQ600 
STKEGE 20 
STKEG64@ 
STKEG660 
STKE@680 
STKEG70@ 
STKE@7 2@ 
STKEQ7 46 
STKEO76@ 
STKEG7 80 
STKEO8O0 
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COLLECTED ALGORITHMS (cont.) 


C VALUES CURRENTLY ASSUMED CORRESPOND TO AN ANS FORTRAN 


C ENVIRONMENT. 


FOR SOME MINI-COMPUTER SYSTEMS THE VALUES MAY 


C HAVE TO BE CHANGED (SEE I@TK@@). 


AAQAARAAANAANARAAAAA 


aQ 


AAD 


QAaAAANAN 


AAAA 


ERROR 


ISTAK (I 


ISTAK( 6) 
ISTAK( 7) 
ISTAK( 8) 
ISTAK( 9) 
ISTAK (1) 


PWN FE 
1 


STATES - 


TEE NUMBER OF UNITS ALLOCATED TO LOGICAL 

THE NUMBER OF UNITS ALLOCATED TO INTEGER 

THE NUMBER OF UNITS ALLOCATED TO REAL, 

THE NUMBER OF UNITS ALLOCATED TO DOUBLE PRECISION 
THE NUMBER OF UNITS ALLOCATED TO COMPLEX 


NITEMS .LT. @ 

- ITYPE .LE. @ .OR. ITYPE .GE. 6 

LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN 
STACK OVERFLOW 


COMMON /CSTAK/DSTAK 


DOUBLE PRECISION DSTAK(5@¢) 
INTEGER ISTAK(1900) 
INTEGER ISIZE(5) 


LOGICAL INIT 


EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 


(DSTAK(1) , ISTAK(1)) 
(ISTAK(1) ,LOUT) 
(ISTAK(2) , LNOW) 
(ISTAK (3) , LUSED) 
(ISTAK (4) , LMAX) 
(ISTAK(5) ,LBOOK) 
(ISTAK(6) , ISIZE(1)) 


DATA INIT/.TRUE./ 


IF (INIT) CALL I@TKGO (INIT, 500, 4) 


IF (NITEMS.LT.@) CALL SETERR(2@HISTKGT - NITEMS.LT.@,2@,1,2) 


IF (ITYPE.LE.@ .OR. ITYPE.GE.6) CALL SETERR 
1 (33HISTKGT - ITYPE.LE.@.OR.ITYPE.GE.6,33,2,2) 


IF (LNOW.LT.LBOOK.OR.LNOW.GT.LUSED .OR.LUSED.GT.LMAX) CALL SETERR 


1 (47HISTKGT - LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN, 


2 47,3, 2) 


ISTKGT = (LNOW*ISIZE(2)-1)/ISIZE(ITYPE) + 2 
I = ( (ISTKGT-1+NITEMS)*ISIZE(ITYPE) - 1 )/ISIZE(2) + 3 


STACK OVERFLOW IS AN UNRECOVERABLE ERROR. 


STKEG82@ 
STKEQ840 
STKEG860 
STKEQ88@ 
STKEDIGO 
STKEO92¢ 
STKEG94@ 
STKEG96G 
STKEG986 
STKE1G00 
STKE192@ 
STKE1G4@ 
STKE1G6¢ 
STKE1G80 
STKE1100 
STKE112¢ 
STKE114@ 
STKE116@ 
STKE118@ 
STKE1200 
STKE122@ 
STKE124@ 
STKE126¢ 
STKE128¢ 
STKE1L30¢ 
STKE132¢ 
STKE134@ 
STKE136@ 
STKE138@ 
STKE1406@ 
STKE142¢ 
STKE144@ 
STKE146@ 
STKE148@ 
STKE150¢ 
STKE152¢ 
STKE154@ 
STKE156@ 
STKE158@ 
STKE160¢ 
STKE162@ 
STKE164@ 
STKE166@ 
STKE168¢ 
STKE17¢0 
STKE172@ 
STKE174@ 
STKEL76@ 
STKE178@ 
STKE1 860 
STKE182¢ 


IF (I.GT.LMAX) CALL SETERR(69HISTKGT - STACK TOO SHORT. ENLARGE ITSTKE184@ 
1 AND CALL ISTKIN IN MAIN PROGRAM. ,69,4,2) 


ISTAK(I-1) CONTAINS THE TYPE FOR THIS ALLOCATION. 
) CONTAINS A POINTER TO THE END OF THE PREVIOUS - 


ALLOCATION. 


ISTAK(I-1) = ITYPE 


ISTAK(I 


) = LNOW 


LOUT = LOUT+1 


LNOW = I 


LUSED = MAX@(LUSED, LNOW) 


RETURN 


END 


SUBROUTINE ISTKRL (NUMBER) 


DE-ALLOCATES THE LAST (NUMBER) ALLOCATIONS MADE IN THE STACK 
BY ISTKGT. 


STKE186@ 
STKE138@ 
STKE190¢ 
STKE192@ 
STKE194@ 
STKE196¢ 
STKE198¢ 
STKE2600 
STKE202@ 
STKE2046 
STKE206@ 
STKE208¢@ 
STKE210¢ 
STKE212¢ 
STKE214¢ 


STKCOGOO 
STKCOG2¢ 
STKCOO40 
STKCOOED 
STKCQY8O 
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COLLECTED ALGORITHMS (cont.) 
C ERROR STATES - 


AAQNAQAAAN 


aan 


AQAanaanaanna 


Qa 


Qa 


BOHN e 


NUMBER .LT. @ 

LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN 

- ATTEMPT TO DE-ALLOCATE NON-EXISTENT ALLOCATION 
- THE POINTER AT ISTAK(LNOW) OVERWRITTEN 


COMMON /CSTAK/DSTAK 


DOUBLE PRECISION DSTAK(5@@) 
INTEGER ISTAK(160¢@) 
LOGICAL INIT 


EQUIVALENCE (DSTAK(1),ISTAK(1)) 

EQUIVALENCE (ISTAK(1),LOUT) 

EQUIVALENCE (ISTAK(2) ,LNOW) 

EQUIVALENCE (ISTAK(3) ,LUSED) 

EQUIVALENCE (ISTAK(4) , LMAX) 

EQUIVALENCE (ISTAK(5) ,LBOOK) 

DATA INIT/.TRUE./ 

IF (INIT) CALL I@TKOO (INIT, 540, 4) 

IF (NUMBER.LT.@) CALL SETERR(2@GHISTKRL — NUMBER.LT.@,2@,1,2) 


IF (LNOW.LT.LBOOK.OR.LNOW.GT.LUSED.OR.LUSED.GT.LMAX) CALL SETERR 


1 (47HISTKRL - LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN, 
2 47,2,2) 


IN = NUMBER 
IF (IN.EQ.@) RETURN 


IF (LNOW.LE.LBOOK) CALL SETERR 


1 (SSHISTKRL - ATTEMPT TO DE-ALLOCATE NON-EXISTENT ALLOCATION, 
2 554352) 


CHECK TO MAKE SURE THE BACK POINTERS ARE MONOTONE. 


IF (ISTAK(LNOW) .LT.LBOOK.OR.ISTAK(LNOW) .GE.LNOW-1) CALL SETERR 


1 (47HISTKRL - THE POINTER AT ISTAK(LNOW) OVERWRITTEN, 
2 47,4,2) 


LOUT = LOUT-1 
LNOW = ISTAK(LNOW) 
IN = IN-1 

GO TO 1¢ 


END 


SUBROUTINE ISTKIN(NITEMS, ITYPE) 


INITIALIZES THE STACK ALLOCATOR, SETTING THE LENGTH OF THE STACK. 


ERROR STATES - 


1 


1 


- NITEMS .LE. 


uy 
2 - ITYPE .LE. # .OK, ITYPE .GE. 6 


LOGICAL INIT 
DATA INIT/.TRUE./ 
IF (NITEMS.LE.@) CALL SETERR(2@HISTKIN - NITEMS.LE.@,26,1,2) 


IF (ITYPE.LE.@.OR.ITYPE.GE.6) CALL SETERR 
(33HISTKIN ~ ITYPE.LE.@.OR.ITYPE.GE.6,33,2,2) 


IF (INIT) CALL I@TKO@(INIT,NITEMS, ITYPE) 
RETURN 


END 


STKCG1606 
STKCG120 
STKCO14@ 
STKCO160 
STKCO18¢ 
STKCO2060 
STKCO22¢ 
STKCO24G 
STKCG260 
STKCO280 
STKCO300 
STKCO320 
STKCO346 
STKCO360 
STKCO380 
STKCO400 
STKCO42¢ 
STKCG44@ 
STKCO460 
STKCO480 
STKCG500 
STKCO520 
STKCO54¢ 
STKCO560 
STKCO58@ 
STKCH6OO 
STKCQ626 
STKCO64¢ 
STKCQ660 
STKCG68¢ 
STKCO70@ 
STKCQ@7 20 
STKCO74@ 
STKCO766 
STKCO78¢ 
STKCO8G0 
STKCG82¢ 
STKCO84¢ 
STKCO860 
STKCO88O 
STKCO9OO 
STKCO920 
STKCO94G 
STKCO96@ 
STKCO98G 
STKC1000 
STKC1620 
STKC1O4¢ 
STKC106@ 


STKFOOGO 
STKFOO20 
STKFOO4@ 
STKFOG6G 
STKFOO8¢ 
STKFO¢106¢ 
STKFG12¢ 
STKFQ 140 
STKFO16¢ 
STKFO180 
STKFG2060 
STKFQ22¢ 
STKFG246 
STKFO266 
STKFO28¢ 
STKFO306¢ 
STKFQ32¢ 
STKFO346 
STKFO360 
STKFO38¢ 
STKFO4066 
STKFO426 
STKFO440 
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COLLECTED ALGORITHMS (cont.) 


AQANAANATAANA 


aQ 


ANAQAAADNRNAN 


io} 


RETURNS THE NUMBER OF ITEMS OF TYPE ITYPE THAT REMAIN 
TO BE ALLOCATED IN ONE REQUEST. 


INTEGER FUNCTION ISTKQU(ITYPE) 


ERROR STATES - 


1 - LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN 
2 - ITYPE .LE. @ .OR. ITYPE .GE. 6 


1 


COMMON /CSTAK/DSTAK 


DOUBLE PRECISION DSTAK(5@@) 


INTEGER ISTAK(100) 
INTEGER ISIZE(5) 


LOGICAL INIT 


EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 


(DSTAK(1) , ISTAK(1)) 
(ISTAK(2) , LNOW) 
(ISTAK(3) ,LUSED) 
(ISTAK (4) , LMAX) 
(ISTAK(5) , LBOOK) 
(ISTAK(6) , ISIZE(1)) 


DATA INIT/.TRUE./ 


IF (INIT) CALL I@TKO@ (INIT, 500, 4) 


IF (LNOW.LT.LBOOK.OR.LNOW.GT.LUSED.OR.LUSED.GT.LMAX) CALL SETERR 
(47HISTKQU - LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN, 


2 47,1,2) 


1 


IF (ITYPE.LE.@.OR.ITYPE.GE.6) CALL SETERR 
(33HISTKQU - ITYPE.LE.@.OR.ITYPE.GE.6, 33,2,2) 


ISTKQU = MAX@( ((LMAX-2)*ISIZE(2))/ISIZE(ITYPE) 


1 
2 


CHANGES THE LENGTE OF THE FRAME AT THE TOP OF THE STACK 


TO 


RETURN 


END 


INTEGER FUNCTION ISTKMD (NITEMS) 


NITEMS. 


ERROR STATES — 


- (LNOW*ISIZE(2)-1)/ISIZE(ITYPE) 


- 1,4) 


1 - LNOW OVERWRITTEN 


2 - ISTAK(LNOWO-1) OVERWRITTEN 


1 


COMMON /CSTAK/DSTAK 


DOUBLE PRECISION DSTAK(50@) 


TEGER ISTAK (1660) 


EQUIVAI-ENCE (DSTAK(1),ISTAK(1)) 
EQUIVALENCE (ISTAK(2) ,LNOW) 


LNOWO = LNOW 


CALL ISTKRL(1) 


ITYPE = ISTAK(LNOWO-1) 


IF (ITYPE.LE.@.OR.ITYPE.GE.6) CALL SETERR 
(35HISTKMD - ISTAK(LNOWO-1) OVERWRITTEN, 35,1,2) 


ISTKMD = ISTKGT(NITEMS, ITYPE) 


RETURN 


END 


STKAGOOD 
STKAGO2@ 
STKAGO40 
STKAGG60 
STKAGO8O 
STKAQG1 00 
STKAG12@ 
STKAQG14@ 
STKAG160 
STKAG180 
STKAG200 
STKAG22¢ 
STKAG240 
STKAG260 
STKAG28¢ 
STKAO300 
STKAQ320 
STKAG34@ 
STKAD360 
STKAG380 
STKAO40¢ 
STKAG420 
STKAG440 
STKAG460 
STKAG48@ 
STKAG50@ 
STKAG52@ 
STKAG54¢ 
STKAG56@ 
STKAG58&@ 
STKAGE6OO 
STKAG620 
STKAG640 
STKAG66G 
STKAG68O 
STKAG70O 
STKAO7 26 
STKAO74@ 
STKAO760 
STKAG78@ 
STKAO8OO 
STKAQ8206 
STKAG84¢ 


STKBOOOO 
STKBOO20 
STKBOG4O 
STKBOGED 
STKBOO8O 
STKBG1OAG 
STKBO12¢ 
STKBQ14¢ 
STKBO16@ 
STKBG18@ 
STKBO20@ 
STKBO220 
STKBO240 
STKBO260 
STKBO28@ 
STKBO300 
STKBO32@ 
STKBO34@ 
STKBO36¢ 
STKBO38@ 
STKBO4060 
STKBO42¢ 
STKBO44@ 
STKBO46@ 
STKBQO486 
STKBO506@ 
STKBQ52¢ 
STKBO54@ 
STKBO56@ 
STKBO580 
STKBO660 
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COLLECTED ALGORITHMS (cont.) 


QAADAAAANAANN 


Q 


C 
C 
Cc 


AAANANA 


INTEGER FUNCTION ISTKST(NFACT) 
RETURNS CONTROL INFORMATION AS FOLLOWS 
NFACT ITEM RETURNED 
LNOW, THE CURRENT ACTIVE LENGTH 


LUSED, THE MAXIMUM USED 
LMAX, THE MAXIMUM ALLOWED 


EWN Ee 


COMMON /CSTAK/DSTAK 

DOUBLE PRECISION DSTAK(50@) 
INTEGER ISTAK(10060) 

INTEGER ISTATS (4) 

LOGICAL INIT 


EQUIVALENCE (DSTAK(1),ISTAK(1)) 
EQUIVALENCE (ISTAK(1),ISTATS(1)) 


DATA INIT/.TRUE./ 
IF (INIT) CALL I@TKOO(INIT, 500, 4) 


IF (NFACT.LE.@.OR.NFACT.GE.5) CALL SETERR 


1 (33HISTKST - NFACT.LE.@.OR.NFACT.GE.5,33,1,2) 


ISTKST = ISTATS (NFACT) 
RETURN 


END 


SUBROUTINE I@TKO@(LARG,NITEMS, ITYPE) 
INITIALIZES THE STACK TO NITEMS OF TYPE ITYPE 
COMMON /CSTAK/DSTAK 


DOUBLE PRECISION DSTAK(5@¢) 
INTEGER ISTAK(1000) 

LOGICAL LARG, INIT 

INTEGER ISIZE(5) 


EQUIVALENCE (DSTAK(1),ISTAK(1)) 
EQUIVALENCE (ISTAK(1) ,LOUT) 
EQUIVALENCE (ISTAK(2) ,LNOW) 
EQUIVALENCE (ISTAK(3) ,LUSED) 
EQUIVALENCE (ISTAK(4) ,LMAX) 


EQUIVALENCE (ISTAK(5) ,LBOOK) 
EQUIVALENCE (ISTAK(6),ISIZE(1)) 


DATA INIT/.FALSE./ 


LARG = .FALSE. 
IF (INIT) RETURN 


HERE TO INITIALIZE 


INIT = .TRUE. 


SET DATA SIZES APPROPRIATE FOR A STANDARD CONFORMING 
FORTRAN SYSTEM USING THE FORTRAN "STORAGE UNIT" AS THE 


MEASURE OF SIZE. 


LOGICAL 
ISIZE (1) 
INTEGER 
ISIZE(2) 
REAL 
ISIZE(3) 1 
DOUBLE PRECISION 
ISIZE(4) = 2 


1 


1 


LOUT, THE NUMBER OF CURRENT ALLOCATIONS 


STKSOGOO 
STKSOO2@ 
STKSOG40 
STKSOO6@ 
STKSOG8@ 
STKSG1060 
STKS@12¢ 
STKSG14@ 
STKSO16@ 
STKSG180 
STKSO20¢ 
STKSO220 
STKSO246 
STKS@26@ 
STKS6280 
STKSO300 
STKS032¢ 
STKSO340 
STKSO36@ 
STKSO380 
STKSO490 
STKS0420 
STKSO440 
STKS@46¢ 
STKS@480 
STKSO5060 
STKS@52@ 
STKS0540 
STKSG560 
STKSO580 
STKS(600 
STKS062@ 
STKS0640 


STKGOGOO 
STKGOO2¢6 
STKGOO40 
STKGQO6G 
STKGOG8@ 
STKGO1OO 
STKGG120 
STKGO146 
STKGG16@ 
STKGO18@ 
STKGO26@ 
STKGG220 
STKGG24@ 
STKGO26@ 
STKGG28¢ 
STKGO360 
STKGO320 
STKGO340 
STKGO36¢ 
STKGO38@ 
STKGO400 
STKGO420 
STKGO440 
STKGO460 
STKGQ480 
STKGG500 
STKGO52¢ 
STKGO540 
STKGG560 
STKGG58@ 
STKGO600 
STKGV620 
STKGG640 
STKGQ66@ 
STKGG680@ 
STKGO7O@ 
STKGQ72¢ 
STKGG74@ 
STKGO76@ 
STKGQ7 80 
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C COMPLEX STKGO8OG 
ISIZE(5) = 2 STKGO82¢ 
Cc STKGG84G 
LBOOK = 1¢@ STKGO860 
LNOW = LBOOK STKGO880 
LUSED = LBOOK STKGOIGO 
LMAX = MAXO( (NITEMS*ISIZE(ITYPE))/ISIZE(2), 12 } STKGG920 
LOUT = @ STKGO94@ 
c STKGO96@ 
RETURN STKGO98@ 
Cc STKG1OO@ 
END STKG162@ 


ACM Transactions on Mathematical Software, Vol. 5, No. 4, December 1979, Page 524. 
REMARK ON ALGORITHM 528 


Framework for a Portable Library [Z] 
[P.A. Fox, A.D. Hall, and N.L. Schryer, ACM Trans. Math. Software 4, 2 (June 
1978), 177-188] 


Phyllis Fox [Recd 11 September 1979] 
Bell Laboratories, 600 Mountain Ave., Murray Hill, NJ 07974 


In the machine-dependent constants for the PDP 10 computer with KI processor, 
a transcription error has been found in the double-precision value for logiob. 
The DATA line should read as follows: 


C DATA LOG10(1),LOG10(2)/"177464202324, ”047674776746/ MCHD1680 


(See the complete listing of Algorithm 528, available from the ACM Algorithms 
Distribution Service or to be found in “Collected Algorithms from ACM.”) 
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ALGORITHM 5829 
Permutations to Block Triangular Form [F1 ] 


1. S. DUFF and J. K. REID 
AERE Harwell 


Key Words and Phrases: symmetric permutations, block triangular form, depth first search algorithm, 
sparse matrices 

CR Categories: 5.0, 5.1, 5.3, 5.4 

Language: ANSI Fortran 


DESCRIPTION 


Given the column numbers of the nonzeros in each row of a sparse matrix, this 
subroutine finds a symmetric permutation that makes the matrix block lower 
triangular. It can also be interpreted as accepting the row numbers of the non- 
zeros in each column and symmetrically permuting to block upper triangular form. 
If the user submits a matrix with zeros on the diagonal, subroutine MC13D might 
give a block triangular form which could be further reduced by unsymmetric 
permutations. To obtain the best results, the user is advised first to permute the 
matrix so that it has a zero-free diagonal. This can be done by Harwell subroutine 
MC21A (Duff [1]). 
The subroutine is evoked by the Fortran statement 


CALL MC13D(N, ICN, LICN, IP, LENR,IOR,IB,NUM,IW) 


where the parameters are described in the listing given here. 

The subroutine is based on Tarjan’s depth first search algorithm (3], and its design 
is described in detail in Duff and Reid [2]. They also discuss experimental results 
from using this subroutine which has been tested on a wide range of both structured 
and randomly generated matrices. 

This routine has been written in ANSI Fortran. Special comment cards have 
been included so that Harwell subroutine OE@4A can be used to make an IBM 
Fortran version that uses half-length integers (INTEGER*2) for all the arrays 
except IP. This approximately halves the core requirements at the cost of restricting 
the order of the system to 2” — 1. 
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COLLECTED ALGORITHMS (cont.) 
ALGORITHM 


[Subroutines MC13D and MC13E are printed here. A test deck for {MC13D is 
available from the ACM Distribution Service (see inside back cover for order 
form), or may be found in “Collected Algorithms from ACM.”’] 


C 
C 
Cc 


aAaAgaAgNgAAANaNAnANANMNANNANAaANANAn 


QO 


C 
C 
C 
C 
C 


C 
C 


I IS THE IBM VERSION SI/MC1 
S IS THE STANDARD FORTRAN VERSION MC1l 
MCL 

SUBROUTINE MC13D(N, ICN, LICN, IP, LENR, IOR, IH, NUM, IW) MC1 
MCL 

DESCRIPTION OF PARAMETERS. MC1 
INPUT VARIABLES .... N,ICN,LICN,IP,LENR. MCl 
OUTPUT VARIABLES I0OR,IB,NUM. MCL 
MCL 

N ORDER OF THE MATRIX. MCI 
ICN ARRAY CONTAINING THE COLUMN INDICES OF THE NON-ZEROS. THOSE MC1 
BELONGING TO A SINGLE ROW MUST BE CONTIGUOUS BUT’ THE ORDERING MC1 

OF COLUMN INDICES WITHIN EACH ROW IS UNIMPORTANT AND WASTED MC1 
SPACE BETWEEN ROWS IS PERMITTED. MC1 
LICN LENGTH OF ARRAY ICN. MC1 
IP IP(I), I=1,2,...N, IS THE POSITION IN ARRAY ICN OF THE FIRST MCL 
COLUMN INDEX OF A NON-ZERO IN ROW I. MCL 
LENR LENR(I) IS THE NUMBER OF NON-ZEROS IN ROW I, J=1,2,...N. MCL 
IOR IOR(I) GIVES THE POSITION IN THE ORIGINAL ORDERING OF THE ROW MCL 
OR COLUMN WHICH IS IN POSITION I IN THE PERMUTED FORM, I=1,2,..N. MCl 

IB IB(I) IS THE ROW NUMBER IN THE PERMUTED MATRIX OF THE BEGINNING MC1 
OF BLOCK I, I=1,2,...NUM. MC1 
NUM NUMBER OF BLOCKS FOUND. MC1 
IW WORK ARRAY .. SEE LATER COMMENTS. MC1 
MC1 

INTEGER IP(N) MC1 
INTEGER*2 ICN(LICN) ,LENR(N) ,IOR(N),IB(N),IW(N, 3) I/MC1l 
INTEGER ICN(LICN), LENR(N), IOR(N), IB(N), IW(N,3) MC1 
CALL MC13E(N, ICN, LICN, IP, LENR, IOR, IB, NUM, IW(1,1), MCL 

* IW(1,2), IW(1,3)) MC1 
RETURN MC1 

END MCL 
SUBROUTINE MC13E(N, ICN, LICN, IP, LENR, ARP, 1B, NUM, LOWL, MC1l 

* NUMB, PREV) MC1 
INTEGER STP, DUMMY MC1 
INTEGER IP(N) MCI 

MCL 

ARP(I) IS ONE LESS THAN THE NUMBER OF UNSEARCHED EDGES LEAVING MC1 
NODE I. AT THE END OF THE ALGORITHM IT IS SET TO A MCL 
PERMUTATION WHICH PUTS THE MATRIX IN BLOCK LOWER MC1 
TRIANGULAR FORM. MC1l 
IB(I) IS THE POSITION IN THE ORDERING OF THE START OF THE ITH MCL 
BLOCK. IB(N+1-I) HOLDS THE NODE NUMBER OF THE ITH NODE MCl 

ON THE STACK. MCI 
LOWL(I) IS THE’ SMALLEST STACK POSITION OF ANY NODE TO WHICH A PATH MC1 
FROM NODE I HAS BEEN FOUND. IT IS SET TO N+1 WHEN NODE I MC1 

IS REMOVED FROM THE STACK. MC1 
NUMB(I) IS THE POSITION OF NODE I IN THE STACK IF IT IS ON MC1 
IT, IS THE PERMUTED ORDER OF NODE I FOR THOSE NODES MCl 
WHOSE FINAL POSITION HAS BEEN FOUND AND IS OTHERWISE ZERO. MC1 
PREV(IL) IS THE NODE AT THE END OF THE PATH WHEN NODE I WAS MCI 
PLACED ON THE STACK. MC1 
INTEGER*2 ICN(LICN) ,LENR(N) ,ARP(N),IB(N),LOWL(N) ,NUMB(N), L/MC1 
1PREV (N) I/MC1 
INTEGER ICN(LICN), LENR(N), ARP(N), IB(N), LOWL(N), NUMB(N), MC1 

* PREV (N) MC1 
MC1 

MC1 

ICNT IS THE NUMBER OF NODES WHOSE POSITIONS IN FINAL ORDERING HAVE MCl 
BEEN FOUND. MC1 
ICNT = @ MC1 

NUM IS THE NUMBER OF BLOCKS THAT HAVE BEEN FOUND. MC1 
NUM = @ MC1 
NNM1 = N+N- 1 MC1 

MCL 

INITIALIZATION OF ARRAYS. MC1 
DO 1¢ J=1,N MC1 
NUMB(J) = @ MC1l 
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ARP(J) = LENR(J) - 1 MC1 37 

19 CONTINUE MC1 38¢@ 

Cc MC1 39¢ 
Cc MC1l 466 
DO 9@ ISN=1,N MC1l 41¢ 

C LOOK FOR A STARTING NODE MC1l 420 
IF (NUMB(ISN) .NE.@) GO TO 9¢ MC1] 43¢ 

Iv = ISN MC1 446 

C IST IS THE NUMBER OF NODES ON THE STACK ... IT IS THE STACK POINTER. MCl 45¢ 
IST = 1 MC1l 46¢ 

C PUT NODE IV AT BEGINNING OF STACK. MC1 47 
LOWL(IV) = 1 MC1l 48¢ 
NUMB(IV) = 1 MC1 4906 

IB(N) = IV MC1l 500 

Cc MC1 516 
C THE BODY OF THIS LOOP PUTS A NEW NODE ON THE STACK OR BACKTRACKS. MCl 52¢ 
DO- 86 DUMMY=1,NNM1 MC1 53¢ 

Il = ARP(IV) MC1 546 

C HAVE ALL EDGES LEAVING NODE IV BEEN SEARCHED. MC1l 5506 
IF (11.LT.@) GO TO 30 MCl 56@ 

I2 = IP(IV) + LENR(IV) ~ 1 MC1l 576 

Il = 12 - Il MC1 58¢ 

Cc MC1 59¢@ 
C LOOK AT EDGES LEAVING NODE IV UNTIL ONE ENTERS A NEW NODE OR MCl 60¢ 
Cc ALL EDGES ARE EXHAUSTED. MC1l 61¢ 
DO 2@ II=11,12 MCl 620 

IW = 1CN(IT) MC1l 63@ 

C HAS NODE IW BEEN ON STACK ALREADY. MC1 64@ 
IF (NUMB(IW) .EQ.6) GO TO 70 MC1l 65@ 

C UPDATE VALUE OF LOWL(IV) IF NECESSARY. MC1 66¢ 
IF (LOWL(IW) .LT.LOWL(IV)) LOWL(IV) = LOWL(IW) MCl 6706 

2¢ CONTINUE MC1 68¢ 

Cc MC1 69¢ 
C THERE ARE NO MORE EDGES LEAVING NODE IV. MC1 70@ 
ARP(IV) = -1 MCl 710 

C IS NODE IV THE ROOT OF A BLOCK. MC1 720 
30 IF (LOWL(IV) .LT.NUMB(IV)) GO TO 6¢ MC1l 730 

Cc MC1 746 
C ORDER NODES IN A BLOCK. MC1l 756 
NUM = NUM + 1 MCl 760 

ISTl = N+ 1 - IST MCl 77 

LCNT = ICNT + l MC1l 784 

C PEEL BLOCK OFF THE TOP OF THE STACK STARTING AT THE TOP AND MC1l 7990 
C WORKING DOWN TO THE ROOT OF THE BLOCK. MC1l 8¢¢ 
DO 46 STP=IST1,N MCl 81¢@ 

IW = IB(STP) MC1l 82 

LOWL(IW) = N+ 1 MC1 83¢@ 

ICNT = ICNT + 1 MC1l &4¢ 

NUMB(IW) = ICNT MC1 85@ 

IF (IW.EQ.IV) GO TO 5@ MC1 869 

4g CONTINUE MC1 876 

50 IST = N - STP MC1l 88@ 
IB(NUM) = LCNT MCl 89¢ 

C ARE THERE ANY NODES LEFT ON THE STACK. MC1 960 
IF (1ST.NE.@) GO TO 6¢ MCL 910 

C HAVE ALL THE NODES BEEN ORDERED. MC1l 92@ 
IF (ICNT.LT.N) GO TO 9% MC1 93@ 

GO TO 10¢ MC1l 94¢ 

re MC1 95¢@ 
C BACKTRACK TO PREVIOUS NODE ON PATH. MC1 960 
60 IW = IV MCl 97¢ 

IV = PREV(IV) MC1l 98¢ 

C UPDATE VALUE OF LOWL(IV) IF NECESSARY. MC1 99¢ 
IF (LOWL(IW) .LT.LOWL(IV)) LOWL(IV) = LOWL(IW) MC1 1000 

GO TO 8¢ MC1 1414 

Cc MC1 162¢ 
C PUT NEW NODE-ON THE STACK. MC1 1630 
7¢ ARP(IV) = I2 - II - 1 MC1 104@ 
PREV(IW) = IV MC1 1065¢ 

Iv = IW MC1 1066 

IST = IST +1 MC1 1067 

LOWL(IV) = IST MC1 1080 

NUMB(IV) = IST MC1 1990 
K=N+1- IST MC1 1140 

IB(K) = IV MC1 11106 


8@ CONTINUE MC1 112¢ 
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Cc MC1 1130 
9@ CONTINUE MC1 114¢ 

c MC1 115¢@ 
Cc MC1 116@ 
C PUT PERMUTATION IN THE REQUIRED FORM. MC1 117¢ 
164 DO 11¢ I=1,N MC1 118¢ 
II = NUMB(I) MCl 119¢ 

ARP(IT) = I MC1 12060 

11@ CONTINUE MC1 1210 
RETURN MCL 1226 

END MC1 123¢ 

C TEST DECK FOR MC13D ... RUNS ON RANDOM MATRICES ... MAN 10 
INTEGER IP(5@), ICN(1600), IOR(50), IB(51), IW(15@), LENR(5@) MAN 2 
INTEGER BLANK, EX, HOLD(14) MAN 30 
LOGICAL A(5@,50) MAN 46 

DATA BLANK, EX, NOT /1H ,1HX,1H@/ MAN 59 

MM = 5¢ MAN 6¢ 

LICN = 16¢¢ MAN 76 

C MAN 8@ 
C MAIN LOOP. MAN 9¢ 
16 READ (5,99999) N, IPP MAN 160 

IF (N.EQ.6) GO TO 16¢ MAN 116 

WRITE (6,99998) N, IPP MAN 126 

DO 3¢@ J=1,N MAN 1306 

DO 2¢ I=1,N MAN 14¢ 

A(L,J) = .FALSE. MAN 150 

2¢ CONTINUE MAN 160 
A(J,J) = .TRUE. MAN 17¢ 

3¢ CONTINUE MAN 18¢ 

IF (IPP.EQ.@) GO TO 60 MAN 196 

DO 5@ K9=1, IPP MAN 266 

C THESE STATEMENTS SHOULD BE REPLACED BY CALLS TO YOUR FAVOURITE MAN 216 
Cc RANDOM NUMBER GENERATOR TO PLACE TWO PSEUDO-RANDOM NUMBERS MAN 220 
c BETWEEN 1 AND N IN THE VARIABLES I AND J. MAN 23¢ 
46 CALL FAQOLBS(N, I) MAN 240 
CALL FA@IBS(N, J) MAN 250 

IF (A(I,J)) GO TO 4¢ MAN 260 

A(I,J) = .TRUE. MAN 27¢ 

5¢ CONTINUE MAN 28¢ 

C SETUP CONVERTS MATRIX A(I,J) TO REQUIRED SPARSITY-ORIENTED MAN 29¢ 
C STORAGE FORMAT. MAN 3¢4¢ 
6@ CALL SETUP(N, A, MM, IP, ICN, LICN, LENR) MAN 316 
CALL MC13D(N, ICN, LICN, IP, LENR, IOR, IB, NUM, IW) MAN 326 

C OUTPUT REORDERED MATRIX WITH BLOCKING TO IMPROVE CLARITY. MAN 33¢ 
IF (NUM.EQ.1) WRITE (6,99997) NUM MAN 34¢ 

IF (NUM.NE.1) WRITE (6,99996) NUM MAN 350 
IB(NUM+1) = N+ 1 MAN 3606 

INDEX = 16¢ MAN 370. 
IBLOCK = 1 MAN 38¢ 

DO 9% I=1,N MAN 39¢ 

DO 7@ IJ=1, INDEX MAN 4¢¢ 
HOLD(IJ) = BLANK MAN 41¢ 

7@ CONTINUE MAN 42¢ 

IF (1.EQ.IB(IBLOCK)) WRITE (6,99995) MAN 430 

IF (1.EQ.IB(IBLOCK)) IBLOCK = IBLOCK + 1 MAN 446 

JBLOCK = 1 MAN 45¢ 

INDEX = @ MAN 4606 

DO 8@ J=1,N MAN 4706 

IF (J.EQ.IB(JBLOCK)) INDEX = INDEX + 1 MAN 480 

IF (J.EQ.IB(JBLOCK)) HOLD(INDEX) = BLANK MAN 49¢ 

IF (J.EQ.IB(JBLOCK)) JBLOCK = JBLOCK + 1 MAN 50@ 

INDEX = INDEX + l MAN 51 

II = IOR(I) MAN 520 

JJ = IOR(J) MAN 5306 

IF (A(II,JJ)) HOLD(INDEX) = EX MAN 546 

IF (.NOT.A(II,JJ)) HOLD(INDEX) = NOT MAN 55@ 

8¢@ CONTINUE MAN 56¢ 
WRITE (6,99994) HOLD MAN 5706 

9¢ CONTINUE MAN 580 
WRITE (6,99993) (IB(I),I=1,NUM) MAN 5906 

GO TO 104 MAN 60¢ 

c MAN 610 
C FORMAT STATEMENTS. MAN 62¢ 


1¢@ STOP MAN 630 
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99999 FORMAT (214) 
99998 FORMAT (1H1, 2@H MATRIX IS OF ORDER , 13, 9H AND HAS , 13, 
* 23H OFF-DIAGONAL NON-ZEROS) 
99997 FORMAT (///31H THE REORDERED MATRIX WHICH HAS, 13, 1@H BLOCK IS , 
* 11HOF THE FORM/) 
99996 FORMAT (///31H THE REORDERED MATRIX WHICH HAS, 13, 1@H BLOCKS IS, 
* 12H OF THE FORM/) 
99995 FORMAT (3X) 
99994 FORMAT (1X, 1@@A1) 
99993 FORMAT (/46H THE STARTING POINT FOR EACH BLOCK IS GIVEN BY// 
* 26(2x, 14)) 
END 


SUBROUTINE SETUP(N, A, MM, IP, ICN, LICN, LENR) 
LOGICAL A(MM,MM) 
INTEGER IP(N), ICN(LICN), LENR(N) 
DO 19 I=1,N 
LENR(I) = @ 
16 CONTINUE 
IND = 1 
DO 3¢ I=1,N 
IP(I) = IND 
DO 2¢ J=1,N 
IF (.NOT.A(I,J)) GO TO 20 
LENR(L) = LENR(I) + 1 
ICN(IND) = J 
IND = IND + 1 
26 CONTINUE 
36 CONTINUE 
RETURN 
END 


SET 


646 
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ALGORITHM 530 

An Algorithm for Computing the Eigensystem 
of Skew-Symmetric Matrices and a Class 
of Symmetric Matrices [F2] 


R. C. WARD and L. J. GRAY 
Union Carbide Corporation, Nuclear Division 


Key Words and Phrases: eigenvalues, eigenvectors, skew-symmetric matrices, symmetric matrices, 
matrices with constant diagonal 

CR Categories: 5.14 

Language: Fortran 


DESCRIPTION 


The set of Fortran subroutines given here is an implementation of the algorithm 
[3] for finding the eigenvectors x and eigenvalues A such that Ax = Ax, where A 
is a real skew-symmetric matrix or a real tridiagonal symmetric matrix with a 
constant diagonal. The algorithm uses only orthogonal similarity transformations 
and is believed to be the most efficient procedure available for computing all the 
eigenvalues or the complete eigensystem for the indicated classes of matrices. 

The three subroutines of the algorithm and their functions are described as 
follows: 

TRIZD. A subroutine that transforms an arbitrary real skew-symmetric matrix 
to skew-symmetric tridiagonal form using orthogonal similarity transformations, 
saving the pertinent information about these transformations. 

IMZD. A subroutine that computes the eigenvalues and, optionally, the eigen- 
vectors of a symmetric tridiagonal matrix with zeros on the diagonal or of a skew- 
symmetric tridiagonal matrix. 

TBAKZD. A subroutine that computes the eigenvectors of an arbitrary real 
skew-symmetric matrix by back-transforming the eigenvectors of the correspond- 
ing skew-symmetric tridiagonal matrix determined by TRIZD. Subroutines 
TRIZD and TBAKZD are straightforward adaptations of Fortran subroutines 
TRED1 and TRBAK1 [2] (originally published as Algol procedures in [1]) which 
accomplish similar functions for arbitrary real symmetric matrices. A detailed 
description of subroutine IMZD is given by Ward and Gray [3]. 

To determine the complete eigensystem of a full skew-symmetric matrix, the 
user should issue a call to TRIZD, IMZD, and TBAKZD, in that order. If only 
the eigenvalues are desired, then calling TBAKZD is unnecessary. To determine 
the complete eigensystem or only the eigenvalues of a tridiagonal skew-symmetric 
matrix or a tridiagonal symmetric matrix with zero diagonals, the user should 
only issue a call to IMZD. (If {Ai} and {x;} are the eigenvalues and eigenvectors 
of the matrix A, a tridiagonal symmetric matrix with zero diagonals, then the 
eigenvalues and eigenvectors of A + al are {A; + a} and {xj} .) 

Subroutines TRIZD, IMZD, and TBAKZD have been tested extensively on 
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the IBM 360/91 computer at Oak Ridge National Laboratory using double 
precision arithmetic. Some of the test cases are presented in [3]. Since only 
orthogonal similarity transformations are used, the algorithm is numerically 
stable, that is, each computed eigenvalue and its corresponding eigenvector are 


exact for a matrix close to the original matrix. 
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6000 FORMAT (1H1,47HEIGENSYSTEM COMPUTATION OF SKEW-SYMMETRIC TEST , 
4HCASE/ /) 


1 


FUNCTION - 


THIS IS THE MAIN PROGRAM (DRIVER) FOR ILLUSTRATING THE 


USE OF SUBROUTINES TRIZD, IMZD, AND TBAKZD. 


REFERENCES - EIGENSYSTEM COMPUTATION FOR SKEW-SYMMETRIC MATRICES AND 
A CLASS OF SYMMETRIC MATRICES, WARD,R C AND GRAY,L J. 


TO APPEAR IN MANUSCRIPT SECTION OF ACM-TOMS. 


AN ALGORITHM FOR COMPUTING THE EIGENSYSTEM OF SKEW- 


SYMMETRIC MATRICES AND A CLASS OF SYMMETRIC MATRICES, 


TO APPEAR IN ALGORITHM SECTION OF ACM-TOMS. 


REQUIRED FUNCTIONS FOR DRIVER AND SUBROUTINES - 


REAL A(6,6),Z(6,6) ,E(6) 
REAL CON 


INTEGER 


I,J,N,IM1,JP1,MAX, LERR 


LOGICAL MATZ,SKEW 


MAX = 6 


MATZ = .TRUE. 


SET UP SKEW-SYMMETRIC TEST CASE 


WRITE (6,6000) 


SKEW = .TRUE. 


READ AND PRINT TEST MATRIX 


WRITE (6,6001) 

FORMAT (1HO,9X,11HTEST MATRIX/) 

DO 10 I=1,N 
READ (5,6002) (A(I,J),J=1,N) 
WRITE (6,6002) (A(I,J),J=#1,N) 
FORMAT (6F6.0) 


CONTINUE 


COMPUTE EIGENVALUES AND EIGENVECTORS 


CALL TRIZD (MAX,N,A,E) 


CALL IMZD (N,E,MATZ,SKEW,MAX,2Z, IERR) 
IF (IERR .NE. 0) WRITE (6,6003) IERR 
FORMAT (1HO/1HO,11HIMZD IERR =,15) 


CALL TBAKZD (MAX,N,A,N,MAX,Z) 


PRINT EIGENVALUES AND EIGENVECTORS 


WRITE (6,6004) 
FORMAT (1HO/1HO, 2X, 11HEIGENVALUES, 25X, 12HEIGENVECTORS) 


J =0 


J=J+¢+i 


S,SIGN,SQRT,MOD 


MAINOOOL 
MAINOO002 
MAINO003 
MAINO004 
MAINOOO5 
MAINOO06 
MAINO007 
MAINOO08 
MAINOO009 
MAINOO10 
MAINOOI1 
MAINOO12 
MAINOO13 
MAINOO14 
MAINOO15 
MAINOO16 
MAINOO17 
MAINOOL8 
MAINOO19 
MAINO020 
MAINOO21 
MAINOO22 
MAINOO23 
MAINOO24 
MAINOO25 
MAINO026 
MAINOO27 
MAINOO28 
MAINO029 
MAINO030 
MAINOO31 
MAINOO32 
MAINOO33 
MAINOO034 
MAINOO35 
MAINO036 
MAINOO037 
MAINOO38 
MAINO039 
MAINO040 
MAINOO41 
MAINO042 
MAINO043 
MAINO044 
MAINO045 
MAINO046 
MAINO047 
MAINOO48 
MAINO049 
MAINOO050 
MAINOO51 
MAINO052 
MAINOO53 
MAINO054 
MAINOO55 
MAINOO056 
MAINOO57 
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Cc 


6005 


6006 


6007 


18 
20 
6008 


6009 
30 


WRITE (6,6005) 
FORMAT (/) 
IF (E(J) .EQ. 0.D0) GO TO 20 
JP1l = J+l 
WRITE (6,6006) E(J),2(1,J),Z(1,JP1L) 
FORMAT (1X,E15.8,4H * 1,5X,E15.8,5H + ,E15.8,4H * TI) 
WRITE (6,6007) (Z(I,J),Z(1,JP1) ,1=2,N) 
FORMAT (25X,E15.8,5H + ,E15.8,4H * I) 
WRITE (6,6005) 
CON = -Z(1,JP1) 
WRITE (6,6006) E(JP1),Z(1,J),CON 
DO 18 I=2,N 

CON = -Z(1I,JP1) 

WRITE (6,6007) Z(I,J),CON 
CONTINUE 
J=J+1 
GO TO 30 
WRITE (6,6008) E(J),Z(1,J) 
FORMAT (1X,E15.8,9X,E15.8) 
WRITE (6,6009) (Z(1I,J),I#2,N) 
FORMAT (25X,E15.8) 


IF (J .LT. N) GO TO 15 


C *** SET UP TRIDIAGONAL, SYMMETRIC, ZERO DIAGONAL TEST CASE 


Cc 


WRITE (6,6010) 


MAINO058 
MAINO059 
MAINOO60 
MAINOO61 
MAINO062 
MAINO063 
MAINO064 
MAINO065 
MAINOO66 
MAINO067 
MAINO068 
MAINO069 
MAINOO070 
MAINOO71 
MAINOO72 
MAINOO73 
MAINOO74 
MAINOO75 
MAINO076 
MAINOO77 
MAINOO78 
MAINOO79 
MAINOO80 
MAINOO81 
MAINOO82 
MAINO083 


6010 FORMAT (1H1,50HEIGENSYSTEM COMPUTATION OF TRIDIAGONAL, SYMMETRIC, ,MAINO084 


1 24H ZERO DIAGONAL TEST CASE//) MAINOO85 

= 6 MAINOO86 

SKEW = .FALSE. MAINOO87 

DO 40 I=1,N MAINOO88 

E(I) = 1. MAINO089 

DO 40 J=1,N MAINOO90 

A(I,J) = 0. MAINOO91 

40 CONTINUE MAINO092 

DO 50 I=2,N MAINO093 

IM1 = I-1l MAINO094 

A(I,IM1) = E(I) MAINOO95 

ACIMI,I) = E(L) MAINO096 

50 CONTINUE MAINO097 

C MAINO098 
C *** PRINT TEST MATRIX MAINO099 
C MAINO100 
WRITE (6,6011) MAINO101 

6011 FORMAT (1HO,12X,11HTEST MATRIX/) MAINO102 
DO 60 I=1,N MAINO103 

WRITE (6,6002) (A(I,J),J=1,N) MAINO104 

60 CONTINUE MAINO105 

C MAINO106 
C *** COMPUTE EIGENVALUES AND EIGENVECTORS MAINO107 
C MAINO108 
CALL IMZD (N,E,MATZ,SKEW,MAX,Z,IERR) MAINO109 

IF (IERR .NE. 0) WRITE (6,6003) IERR MAINO110 

C MAINO111 
C *** PRINT EIGENVALUES AND EIGENVECTORS MAINO112 
C MAINO113 
WRITE (6,6012) MAINO114 

6012 FORMAT (1HO/1HO, 2X, 1 1HEIGENVALUES, 13X, 12HEIGENVECTORS) MAINO115 
DO 70 J=1,N MAINO116 

WRITE (6,6005) MAINO117 

WRITE (6,6008) E(J),Z(1,J) MAINO118 

WRITE (6,6009) (Z(I,J),1=2,N) MAINO119 

70 CONTINUE MAINO120 
STOP MAINO121 

END MAINO122 
SUBROUTINE TRIZD ( NA, N, A, E ) TRIZO001 
TRIZ0002 

C keke TRIZ0003 
c TRIZO0004 
C FUNCTION - REDUCES A REAL SKEW-SYMMETRIC MATRIX TO A SKEW-SYMMETRICTRIZ0005 
C TRIDIAGONAL MATRIX USING ORTHOGONAL SIMILARITY TRIZ0006 
C TRANSFORMATIONS TRIZO0007 
C TRIZ0008 
C PARAMETERS TRIZ0009 
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aaa annanranaaaaanaanaaaanan 


Tag 


aan 


NA - INPUT INTEGER SPECIFYING THE ROW DIMENSION OF A AS 
DECLARED IN THE CALLING PROGRAM DIMENSION STATEMENT 
N - INPUT INTEGER SPECIFYING THE ORDER OF A 


A(NA,N) - ON INPUT, A CONTAINS THE REAL SKEW-SYMMETRIC MATRIX. 
ONLY THE STRICT LOWER TRIANGLE OF THE MATRIX NEED 
BE SUPPLIED. 
ON OUTPUT, A CONTAINS INFORMATION ABOUT THE ORTHOGONAL 
TRANSFORMATIONS USED IN THE REDUCTION IN ITS FULL 
LOWER TRIANGLE. THE STRICT UPPER TRIANGLE OF A IS 
UNALTERED. 


E(N) 


OUTPUT ARRAY CONTAINING THE LOWER SUBDIAGONAL ELEMENTS 
OF THE TRIDIAGONAL MATRIX IN ITS LAST N-1 POSITIONS. 
E(1) IS SET TO ZERO. 


REQUIRED FUNCTIONS - ABS,SIGN,SQRT 


kkKK 


REAL A(NA,N),E(N) 

REAL F,G,H,SCALE 

REAL ABS,SIGN,SQRT 
INTEGER I,J,K,L,11I,JM1,JP1 


IF (N .EQ. 1) GO TO 230 
*kk MAIN DO LOOP I=N STEP -1 UNTIL 2 


DO 220 II = 2, N 
I=N+2-II 
LetI-l 
H = 0. 

SCALE = 0. 


*kk NORMALIZE ROW 


pO 100 K = 1, L 
SCALE = SCALE + ABS(A(I,K)) 
100 CONTINUE 


IF (SCALE .NE. 0.) GO TO 120 
E(I) = 0. 
GO TO 215 


*k* COMPUTE ELEMENTS OF U VECTOR 


120 pO 130 K= 1, L 
A(I,K) = A(I,K) / SCALE 
H = H + A(I,K) * A(I,K) 
130 CONTINUE 


F = A(I,L) 

G = -SIGN(SQRT(H) ,F) 
E(I) = SCALE * G 
H=H-F#G 

A(I,L) = F-G 

IF (L .EQ. 1) GO TO 200 


*kk COMPUTE ELEMENTS OF A*U/H 


po 180 J = 1, L 
G=0. 
IF (J .EQ. 1) GO TO 150 
IMl=2JjJ-1 


DO 140 K= 1, JMl 
G= G+ A(J,K) * A(I,K) 
140 CONTINUE 


150 IF (J .EQ. L) GO TO 170 
JPL=J+1 


DO 160 K = JPl, L 


TRIZO0010 
TRIZOO11 
TRIZ0012 
TRIZ0013 
TRIZO014 
TRIZOO15 
TRIZOOI6 
TRIZOO17 
TRIZ0018 
TRIZO019 
TRIZ0020 
TRIZ0021 
TRIZ0022 
TRIZ0023 
TRIZ0024 
TRIZ0025 
TRIZ0026 
TRIZ0027 
TRIZ0028 
TRIZ0029 
TRIZ0030 
TRIZ0031 
TRIZ0032 
TRIZ0033 
TRIZ0034 
TRIZ0035 
TRIZ0036 
TRIZ0037 
TRIZ0038 
TRIZ0039 
TRIZO0040 
TRIZ0041 
TRIZ0042 
TRIZ0043 
TRIZ0044 
TRIZ0045 
TRIZ0046 
TRIZ0047 
TRIZ0048 
TRIZ0049 
TRIZO050 
TRIZO051 
TRIZ0052 
TRIZ0053 
TRIZ0054 
TRIZO0055 
TRIZ0056 
TRIZ0057 
TRIZ0058 
TRIZ0059 
TRIZ0060 
TRIZ0061 
TRIZ0062 
TRIZ0063 
TRIZ0064 
TRIZ0065 
TRIZ0066 
TRIZ0067 
TRIZ0068 
TRIZ0069 
TRIZ0070 
TRIZOO71 
TRIZ0072 
TRIZ0073 
TRIZ0074 
TRIZ0075 
TRIZ0076 
TRIZO0077 
TRIZ0078 
TRIZ0079 
TRIZ0080 
TRIZ0081 
TRIZ0082 
TRIZ0083 
TRIZ0084 
TRIZO085 
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aan 


AAAQAAIQIAAQANQAAAAARAAQAAARANQAANANDAANANRAANANADAANRANAANAAMNAKRADAHANAANANAA 


G = G - A(K,J) * A(I,K) TRIZ0086 

160 CONTINUE TRIZ0087 
TRIZ0088 

170 E(J) =G/H TRIZ0089 
180 CONTINUE TRIZ0090 
TRIZO091 

*k*k COMPUTE REDUCED A TRIZ0092 
TRIZ0093 

DO 190 J = 2, L TRIZ0094 

F = A(I,J) TRIZ0095 

G = E(J) TRIZ0096 
JMl=J-1 TRIZ0097 

TRIZ0098 

DO 190 K = 1, JM1 TRIZ0099 

A(J,K) = A(J,K) + F * E(K) - G * A(I,K) TRIZO100 

190 CONTINUE TRIZO101 
TRIZO102 

200 DO 210 K= 1, L TRIZ0103 
A(I,K) = SCALE * A(I,K) TRIZ0104 

210 CONTINUE TRIZO105 
TRIZ0O106 

215 A(I,I) = SCALE * SQRT(H) TRIZO107 
220 CONTINUE TRIZO108 
TRIZO109 

230 E(1) = 0. TRIZ0110 
RETURN TRIZO111 

END TRIZO112 
SUBROUTINE IMZD ( N, E, MATZ, SKEW, NZ, Z, IERR ) IMZDO0001 
IMZD0002 

RERR IMZDO0003 
IMZDO0004 

FUNCTION - COMPUTE THE EIGENVALUES AND OPTIONALLY THE EIGENVECTORS IMZD0005 
OF A SYMMETRIC TRIDIAGONAL MATRIX WITH ZERO DIAGONALS IMZD0006 

OR A SKEW-SYMMETRIC TRIDIAGONAL MATRIX USING AN IMZD0007 

IMPLICIT QR-TYPE ITERATION IMZDO008 

IMZDO009 

PARAMETERS IMZD0010 
IMZDOO11 

N - INPUT INTEGER SPECIFYING THE ORDER OF THE TRIDIAGONAL IMZDO012 
MATRIX IMZDO013 

IMZD0014 

E(N) - ON INPUT, ARRAY CONTAINING THE LOWER SUBDIAGONAL IMZDOO15 
ELEMENTS OF THE TRIDIAGONAL MATRIX IN ITS LAST N-1 IMZDO0016 

POSITIONS. E(1) IS ARBITRARY. IMZD0017 

ON OUTPUT, ARRAY CONTAINS THE EIGENVALUES. THE NON~ZEROIMZDO0018 

EIGENVALUES OCCUR IN PAIRS WITH OPPOSITE SIGNS AND IMZD0019 

ARE FOUND IN ADJACENT LOCATIONS IN E. THE EIGENVALUESIMZD0020 

OF SYMMETRIC MATRICES ARE REAL AND THE EIGENVALUES IMZD0021 

OF SKEW-SYMMETRIC MATRICES ARE PURELY IMAGINARY IMZD0022 

COMPLEX NUMBERS. IF AN ERROR EXIT IS MADE, THE IMZDQ0023 

EIGENVALUES ARE CORRECT FOR INDICES IERR+1,IERR+2...NIMZD0024 

IMZD0025 

MATZ - INPUT LOGICAL VARIABLE SPECIFYING THE EIGENVECTOR IMZDO0026 
OPTION IMZD0027 

= . TRUE. EIGENVECTORS ARE TO BE COMPUTED IMZD0028 

# ,FALSE. EIGENVECTORS ARE NOT TO BE COMPUTED IMZD0029 

IMZD0030 

SKEW - INPUT LOGICAL VARIABLE SPECIFYING TYPE OF INPUT MATRIX IMZD0031 

= . TRUE. INPUT TRIDIAGONAL MATRIX IS SKEW-SYMMETRICIMZDO0032 

= ,FALSE. INPUT TRIDIAGONAL MATRIX IS SYMMETRIC WITHIMZD0033 

ZERO DIAGONALS IMZD0034 

SKEW IS NOT REFERENCED IF MATZ = .FALSE. IMZD0035 

IMZD0036 

NZ - INPUT INTEGER SPECIFYING THE ROW DIMENSION OF Z AS IMZD0037 
DECLARED IN THE CALLING PROGRAM DIMENSION STATEMENT IMZD0038 

IMZD0039 

Z(NZ,N) —- OUTPUT ARRAY CONTAINING THE ORTHOGONAL EIGENVECTORS IMZD0040 

OF THE INPUT TRIDIAGONAL MATRIX. EIGENVECTORS CORRE- IMZD0041 

SPONDING TO ZERO EIGENVALUES ARE NORMALIZE TO UNIT IMZD0042 


2-NORM (LENGTH) AND THOSE CORRESPONDING TO NON-ZERO IMZD0043 
EIGENVALUES HAVE 2~-NORM OF SQUARE ROOT 2. IF THE J-THIMZD0044 
EIGENVALUE IS ZERO OR REAL (I.E. E(J)), ITS EIGEN- IMZDO0045 
VECTOR IS FOUND IN THE J-TH COLUMN OF Z. IF THE J-TH IMZDO0046 
EIGENVALUE IS IMAGINARY (I.E. E(J)*I) WITH E(J+1) = IMZD0047 
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-E(J), THE REAL PART OF ITS EIGENVECTOR IS FOUND IN IMZD0048 
THE J-TH COLUMN OF Z AND ITS IMAGINARY PART FOUND IN IMZD0049 


aaa gagNAAaAaNnNnNNAAMAAAAAAAA 


aaa 


aan 


THE (J+1)-TH COLUMN. IF AN ERROR EXIT IS MADE, Z 
CONTAINS THE EIGENVECTORS ASSOCIATED WITH THE STORED 


EIGENVALUES. 


Z IS NOT REFERENCED IF MATZ = 


IERR - OUTPUT ERROR CODE 


= © NORMAL RETURN (ALL EIGENVALUIS/VECTORS FOUND) 
= J IF THE J-TH EIGENVALUE HAS NOT BEEN DETERMINED 


AFTER 30 ITERATIONS 


REQUIRED FUNCTIONS ~- ABS,SIGN,SQRT,MOD 


KEKE 


kK 


100 
110 


115 


120 


KK 


130 


140 


RK 


150 


160 


REAL  E(N),Z(NZ,N) 
REAL F,G,Q,C,S,R,P,TEST, TMAG 
REAL ABS,SIGN,SQRT 


INTEGER I,J,K,L,M,L0,LOM1,MO,LS,IM1,JP1,KM1,K?1,LM1,MMl, 


IP3, IERR, IEO,ITS,IP1 
INTEGER MOD 
LOGICAL MATZ ,SKEW 


IF (.NOT. MATZ) GO TO 115 
PLACE IDENTITY MATRIX IN Z 


po 110 I= 1, N 
po 100 J=#=1, N 
Z(I,J) = 0. 
CONTINUE 
Z(I,I) = 1. 
CONTINUE 


IERR = 0 
M=N 

MM = M- 1 
E(1) = 0. 
ITS = 0 


IF (M .LT. 2) GO TO 370 
MO =M 


SEARCH FOR NEXT SUBMATRIX TO SOLVE (MATRIX SPLITTING) 


F=0. 

DO 130 I = 1, MMl 
J=M-I 
JPl=JI+1 
G = ABS(E(JP1)) 

TMAG = ABS(E(J)) + F 
TEST = TMAG + G 
IF (TEST .EQ. TMAG) GO TO 140 
F=G 
CONTINUE 
JP1 = 1 


LO = JPl + 1 
LOM1 = JP1 

IF (LOM1 .EQ. M) GO TO 290 
IF (.NOT. MATZ) GO TO 160 
IF (.NOT. SKEW) GO TO 160 


PLACE CORRECT SIGN ON IDENTITY DIAGONALS 


DO 150 I = LOMI, M, 4 
Z(1,1I) = -Z(I,1) 
IP3 =I +3 
IF (IP3 .GT. M) GO TO 160 
Z(IP3,I1P3) = -Z(IP3,1P3) 
CONTINUE 


IF (LO .EQ. M) GO TO 300 
IEO = M - LO 
IEO = MOD(IEO,2) 


IMZD0050 
IMZD0051 
IMZD0052 
IMZD0053 
IMZD0054 
IMZDO055 
IMZD0056 
IMZD0057 
IMZD0058 
IMZD0059 
IMZDO0060 
IMZD0061 
IMZD0062 
IMZD0063 
IMZD0064 
IMZD0065 
IMZD0066 
IMZD0067 
IMZD0068 
IMZD0069 
IMZD0070 
IMZD0071 
IMZD0072 
IMZD0073 
IMZD0074 
IMZD0075 
IMZD0076 
IMZD0077 
IMZD0078 
IMZD0079 
IMZD0080 
IMZD0081 
IMZD0082 
IMZD0083 
IMZD0084 
IMZDO0085 
IMZD0086 
IMZD0087 
IMZD0088 
IMZD0089 
IMZD0090 
IMZD0091 
IMZDO0092 
IMZD0093 
IMZD0094 
IMZDO095 
IMZD0096 
IMZD0097 
IMZD0098 
IMZDO0099 
IMZDO100 
IMZDO101 
IMZD0102 
IMZD0103 
IMZD0104 
IMZD0105 
IMZD0106 
IMZD0107 
IMZD0108 
IMZDO109 
IMZD0110 
IMZD0111 
IMZD0112 
IMZD0113 
IMZDO0114 
IMZDO115 
IMZD0116 
IMZD0117 
IMZD0118 
IMZDO0119 
IMZD0120 
IMZD0121 
IMZD0122 
IMZD0123 
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L = LO 
IF (IEO .EQ. 0) GO TO 230 


C 
C *k* FIND ZERO EIGENVALUE OF ODD ORDERED SUBMATRICES 
Cc 

c=0. 

S=-l. 


DO 190 I = LO, MMI, 2 
K = MM] + LO - I 
KPl =K +1 
Q = -S * E(KP1) 
E(KP1) = C * E(KP1) 
IF (ABS(E(K)) .GT. ABS(Q)) GO TO 170 
C = E(K) / Q 
R = SQRT(C*C + 1.) 
E(K) =Q*R 
S=#1./R 
C=C kS 
GO TO 180 
170 S=Q / E(K) 
R = SQRT(1. + S*S) 
E(K) = E(K) * R 


c=#1./R 
S#=S *¢ 
180 IF (.NOT. MATZ) GO TO 190 
C 
C *** ACCUMULATE TRANSFORMATIONS FOR EIGENVECTORS 
C 
KMl = K- 1 


Z(KM1,M) = -S * Z(KM1,KM1) 
Z(KM1,KM1) = C * Z(KM1,KM1) 
DO 185 J = KPl, M, 2 
Z(J,KM1) = S * Z(J,M) 
Z(J,M) = C * Z2(J,M) 
185 CONTINUE 


190 CONTINUE 
M = MM1 
MMl = M- 1 
IF (LO .EQ. M) GO TO 300 


**kk CHECK FOR CONVERGENCE OR SMALL SUBDIAGONAL ELEMENT 


aaa 


200 DO 210 I = LO, MMI, 2 

K = MMl + LO - I 

L=K+1 

" TMAG = ABS(E(L)) + ABS(E(K-1)) 

TEST = TMAG + E(K) 

IF (TEST .EQ. TMAG) GO TO 220 
210 CONTINUE 

L = LO 

220 IF (L .EQ. M) GO TO 300 


C *** FORM SHIFT 


230 ITS = ITS + 1 
IF (ITS .GT. 30) GO TO 360 
F = E(M-3) 

E(M-2) 

E(MM1) 

E(M) 

((C-F) * (C+F) + (S-G) * (S+G)) / (2. * G * C) 

SQRT(P*P + 1.) 

(G / (P + SIGN(R,P))) - C 

F = E(L) 

LMI = L- 1 

E(LM1L) = ((F-S) * (F+S) +C * Q) / F 


C *** PERFORM ONE IMPLICIT QR ITERATION ON CHOLESKY FACTOR 


LS = LOM1 

c= 1. 

S=l. 

DO 280 I = L, MMl 
IPl = IT +1 
IMl =I-1 


IMZD0124 
IMZD0125 
IMZD0126 
IMZD0127 
IMZD0128 
IMZD0129 
IMZD0130 
IMZD0131 
IMZD0132 
IMZD0133 
IMZD0134 
IMZD0135 
IMZD0136 
IMZD0137 
IMZD0138 
IMZD0139 
IMZD0140 
IMZD0141 
IMZD0142 
IMZD0143 
IMZD0144 
IMZDO0145 
IMZD0146 
IMZD0147 
IMZD0148 
IMZD0149 
IMZD0150 
IMZDO151 
IMZD0152 
IMZD0153 
IMZD0154 
IMZDO155 
IMZD0156 
IMZD0157 
IMZD0158 
IMZD0159 
IMZDO160 
IMZD0161 
IMZD0162 
IMZD0163 
IMZD0164 
IMZDO165 
IMZDO166 
IMZDO0167 
IMZD0168 
IMZDO169 
IMZD0170 
IMZDO171 
IMZDO172 
IMZD0173 
IMZDO174 
IMZDO175 
IMZD0176 
IMZDO177 
IMZD0178 
IMZD0179 
IMZDO180 
IMZDO181 
IMZD0182 
IMZD0183 
IMZD0184 
IMZD0O185 
IMZDO1 86 
IMZD0187 
IMZD0188 
IMZDO189 
IMZDO190 
IMZDO191 
IMZD0192 
IMZD0193 
IMZD0194 
IMZDO0195 
IMZDO196 
IMZD0197 
IMZD0198 
IMZD0199 
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Q=S * E(IP1) 
E(IP1) = C * E(IP1) 


IF (ABS(E(IM1)) .GT. ABS(Q)) GO TO 240 


C = E(IML) / Q 

R = SQRT(C*C + 1.) 
E(IM1) =Q*R 
S=1./R 


GO TO 250 
240 S = Q / E(IM1) 
R = SQRT(1. + S*S) 
E(IM1) = E(IM1) * R 
c= 1./R 
S=S*C 
250 F = ECIP1L) 
E(IP1) = -S * E(I) + C * F 
E(I) =C * E(I) +S *F 
IF (.NOT. MATZ) GO TO 280 


aa 


DO 260 J = LS, MO, 2 
F = Z(J,IP1) 
Z(J,IP1) = -S * Z(J,IM1) +C * F 
Z(J,IM1) = C * Z(J,IM1) +S * F 
260 CONTINUE 
IF (LS .EQ. LOM1) GO TO 270 
LS = LOM 
GO TO 280 
270 ~=LS = LO 
280 CONTINUE 
E(LM1) = 0. 
GO TO 200 


aaa 


290 E(M) = 0. 
M = MMl 
GO TO 310 


**k*k ITERATION CONVERGED TO EIGENVALUE PAIR 


aaa 


300 E(MM1) = E(M) 
E(M) = -E(M) 
M=M-—- 2 


310 ITs = 0 
MMl = M- 1 
IF (M .GT. LO) GO TO 200 
IF (M .EQ. LO) GO TO 300 
IF (.NOT. MATZ) GO TO 120 
IF (SKEW) GO TO 120 


aaa 


320 K = MO 
330 IF (E(K) .EQ. 0.) GO TO 350 
KMI = K - 1 
DO 340 J = LOM1, MO, 2 
2(J,K) = Z(J,KM1) 
F = Z(J+1,K) 
Z(J+1,KM1) = F 
Z(J+1,K) = -F 
340 CONTINUE 
K = KM 
350 K = K-1 
IF (K .GT. LOM1) GO TO 330 
IF (IERR .NE. 0) GO TO 370 
GO TO 120 


*xk*k ERROR EXIT 


aan 


360 IERR = M 
IF (.NOT. MATZ) GO TO 370 
IF (.NOT. SKEW) GO TO 320 


370 RETURN 
END 


xk*k ACCUMULATE TRANSFORMATIONS FOR EIGENVECTORS 


**kk ITERATION CONVERGED TO ONE ZERO EIGENVALUE 


**k* COMPUTE EIGENVECTORS FROM ORTHONORMAL COLUMNS OF Z IF NOT SKEW 


IMZD0200 
IMZD0201 
IMZD0202 
IMZD0203 
IMZD0204 
IMZD0205 
IMZD0206 
IMZD0207 
IMZD0208 
IMZD0209 
IMZD0210 
IMZD0211 
IMZD0212 


IMZD0213 
IMZD0214 


IMZD0215 
IMZD0216 
IMZD0217 
IMZD0218 
IMZD0219 
IMZD0220 
IMZD0221 
IMZD0222 
IMZD0223 
IMZD0224 
IMZD0225 
IMZD0226 
IMZD0227 
IMZD0228 
IMZD0229 
IMZD0230 
IMZD0231 
IMZD0232 
IMZD0233 
IMZD0234 
IMZD0235 
IMZD0236 
IMZD0237 
IMZD0238 
IMZD0239 
IMZD0240 
IMZD0241 
IMZD0242 
IMZD0243 
IMZD0244 
IMZD0245 
IMZD0246 
IMZD0247 
IMZD0248 
IMZD0249 
IMZD0250 
IMZD0251 
IMZD0252 
IMZD0253 
IMZD0254 
IMZD0255 
IMZD0256 
IMZD0257 
IMZD0258 
IMZD0259 
IMZD0260 
IMZD0261 
IMZD0262 
IMZD0263 
IMZD0264 
IMZD0265 
IMZD0266 
IMZD0267 
IMZD0268 


IMZD0269 
IMZD0270 


IMZD0271 
IMZD0272 
IMZD0273 
IMZD0274 
IMZD0275 
IMZD0276 
IMZD0277 
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100 


110 


120 


SUBROUTINE TBAKZD ( NA, N, A, M, NZ, Z ). 


RRKK 


FUNCTION 


PARAMETERS 


A(NA,N) 


NZ 


Z(NZ,M) 


kaKK 


REAL 
REAL 


- FORMS THE EIGENVECTORS OF A REAL SKEW-SYMMETRIC MATRIX 
BY BACK TRANSFORMING THOSE OF THE CORRESPONDING SKEW- 
SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY TRIZD 


- INPUT INTEGER SPECIFYING THE ROW DIMENSION OF A 
AS DECLARED IN CALLING PROGRAM DIMENSION STATEMENT 


- INPUT INTEGER SPECIFYING THE ORDER OF A 


TBAKOOO1 
TBAKO002 
TBAKO003 
TBAKOO04 
TBAKO005 
TBAKOO06 
TBAK0007 
TBAKO008 
TBAKOO009 
TBAKO010 
TBAKOO11 
TBAKOO12 
TBAKOO13 
TBAKOO14 
TBAKOOL5 


- INPUT ARRAY CONTAINING INFORMATION ABOUT THE ORTHOGONALTBAKOO16 
TRANSFORMATIONS USED IN THE REDUCTION BY TRIZD IN TBAKOO17 
ITS FULL LOWER TRIANGLE 


- INPUT INTEGER SPECIFYING THE NUMBER OF EIGENVECTORS TO 


BE BACK TRANSFORMED 


- INPUT INTEGER SPECIFYING THE ROW DIMENSION OF Z AS 
DECLARED IN CALLING PROGRAM DIMENSION STATEMENT 


- ON INPUT, Z CONTAINS THE REAL AND IMAGINARY (IF 
COMPLEX) PARTS OF THE EIGENVECTORS TO BE BACK TRANS- 
FORMED IN ITS FIRST M COLUMNS 

ON OUTPUT, Z CONTAINS THE REAL AND IMAGINARY (IF 
COMPLEX) PARTS OF THE TRANSFORMED EIGENVECTORS IN 


ITS FIRST M COLUMNS 


A(NA,N) ,Z(NZ,M) 
H,S 


INTEGER I,J,K,L 


IF (M. 
IF (N. 


DO 130 
L = 
H = 


EQ. 0) GO TO 140 
EQ. 1) GO TO 140 


I=2,N 
I-1 
A(I,1). 


IF (H .EQ. 0.) GO TO 130 


DO 120 J=1,M 
Ss = 0. 


DO 100 K= 1, L 
S = S + ACI,K) * Z(K,J) 


CONTINUE 


S= (s /H) /H 


DO 110 K = 1, L 


140 RETURN 


Z(K,J) = Z(K,J) 


CONTINUE 
CONTINUE 


130 CONTINUE 


- S * A(I,K) 


TBAKOO18 
TBAKO019 
TBAKO0020 
TBAKOO21 
TBAKO022 
TBAKO0023 
TBAKO0024 
TBAKO025 
TBAK0026 
TBAK0027 
TBAK0028 
TBAKO029 
TBAK0030 
TBAKOO31 
TBAK0032 
TBAKO033 
TBAK0034 
TBAKO035 
TBAKO036 
TBAK0037 
TBAKO0038 
TBAKO039 
TBAKO040 
TBAKO041 
TBAKO042 
TBAK0043 
TBAKO044 
TBAKO045 
TBAK0046 
TBAKO047 
TBAK0048 
TBAKO049 
TBAKOO050 
TBAKO051 
TBAKO052 
TBAKO053 
TBAKO054 
TBAKOO055 
TBAKO056 
TBAKO057 
TBAKO058 
TBAKO059 
TBAKO060 
TBAKO061 
TBAK0062 
TBAKO063 
TBAKO064 
TBAKO065 
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ALGORITHM 531 
Contour Plotting [J6] 


WILLIAM V. SNYDER 
Jet Propulsion Laboratory 


Key Words and Phrases: contour plotting 
CR Categories: 8.2 
Language: Fortran 


DESCRIPTION 


Given a two-dimensional array of samples of a surface, contour values, and a 
subroutine to draw lines, the subroutine GCONTR determines sequences of 
points in the plane which may be used to draw contours through equal values of 
the surface. 

A contour plotting algorithm may be constructed by following contours from 
some starting point until they either close or intersect a boundary, or by examining 
each cell of the grid in turn and drawing all contours found inside the cell. The 
advantages of contour following are that contour labeling is relatively easy and 
that the pen of an incremental plotter does not move about as much without 
writing anything. The advantages of methods which draw all contours found 
inside a cell are that less auxiliary storage is needed and that each cell can be 
completely processed before going on to the next, thereby allowing generation of 
contours over a much larger array than can be accommodated in main memory 
at one time. 

GCONTR is of the type which follows contours. On a representative problem, 
a program using GCONTR generated about 11,000 plotter commands with about 
57,000 commands generated by a program using a cellular method. For this 
problem, grid lines, user identification, and a table of contour values required 
about 36,000 additional commands. 

Since the data used by contour plotting programs are presented at discrete 
points and since the contour values are not necessarily equal to the dependent 
variable values at the nodal points of the mesh, some method must be used to 
estimate the point at which a contour value intersects the edge of a cell. If one 
uses nonlinear interpolation, there is the possibility of multiple intersections of a 
contour with an edge and the possibility of closed contours which intersect no 
edges; if one wants to follow the interpolated surface faithfully, drawing the 
contour entails finding zeros of a nonlinear bivariate function. Linear interpolation 
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has the drawback that extrema occur only at nodal points. GCONTR uses linear 
interpolation. If this does not produce sufficiently smooth, accurate contours, we 
recommend computing more function values or interpolatory subtabulation to a 
finer mesh. If the required storage is larger than desired, the independent variable 
plane is easily divided into separately processed segments. GCONTR does not 
provide automatic subtabulation because different methods work better for 
different problems. Since GCONTR uses a contour following method, any imple- 
mentation of automatic subtabulation would necessarily have a higher cost than 
a reasonable user implementation. 

Once the points of intersection of a contour with edges have been determined, 
one must still decide how to draw the contour line between such intersections. 
We recommend that straight lines be used. Most other curves can cause balloons 
and crossing of contours of different values. 

We now discuss the features which distinguish GCONTR from the methods of 
Cottafava and Le Moli [1] and Crane [2]. GCONTR and the algorithms described 
in [1] and [2] are similar in that all are contour following methods, the data are 
assumed to be presented on the nodes of a topologically rectangular grid, and 
linear interpolation is used along the edges of a cell. 

GCONTR and algorithm [2] begin following a contour as soon as an edge of a 
cell of the coordinate grid is found which the contour line intersects. Edges 
intersected by the contour are flagged in an integer array in [2] and by marks in 
a bitmap in GCONTR. In algorithm [1] a preliminary detection of all intersections 
of edges and contours is done and then the contours are drawn. The details of the 
bookkeeping are not described in [1]. 

Algorithms [1] and [2] start the contour at the first edge found while searching 
along rows or columns of the data array. GCONTR reduces pen-up travel by 
searching along a rectangular spiral starting at the current pen position. All three 
algorithms draw all contours which intersect boundaries before drawing any 
contours which do not. 

Algorithm [1] treats the case of a contour intersecting all four edges of a cell in 
a way which depends on the fixed order of examining the edges. If a cell is 
approached from different directions, different contours will be drawn. Algorithm 
[2] forces the contours to cross inside the cell. When several different contours 
intersect all four edges, the resulting pattern looks like an asterisk. GCONTR 
examines the linear interpolate along the “top” and “bottom” edges of the cell. If 
the interpolate on the top edge is less than the interpolate on the bottom edge, 
the contour line is drawn top-to-left and bottom-to-right. Otherwise, the contour 
line is drawn top-to-right and bottom-to-left. This methods selects the same 
contours if the axes are exchanged. To show this, note that the use of linear 
interpolation along the edges of the unit cell implies that there is some estimated 
function value F’, which occurs at the same abscissa on the top and bottom edges, 
and some estimated function value F, which occurs at the same ordinate on the 
“left” and “right” edges. It is easy to show that F, = Fy. Therefore, the contour 
of value F’, is the only contour which crosses inside the cell, and it divides the cell 
into four rectangular regions. In two of these regions the esimated function value 
is less than F,. In the other two, the estimated function value is greater than F,. 

Algorithms [1] and [2] consider all data in the array. GCONTR provides a 
means whereby the user may designate excluded elements of the array. The edges 
connecting excluded elements to elements not excluded are not examined. This 
feature has been found to be very useful in practice, as data are frequently not 
presented on a complete rectangular grid. When using methods which do not 
have this feature, one frequently finds extraneous contours drawn between the 
regions containing data and the regions containing no data. 

The output method is not described in [1]. The output from algorithm [2] is an 
ordered set of points in an array which define the contour lines to be drawn. 
GCONTR calls a line drawing subroutine provided by the user. If the user wishes 
to take the risks noted above associated with using other than straight lines for 
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drawing the contours, points may be stored in the line drawing subroutine, and 
a method such as is described in [8] may be used to generate smooth contours. 
Transformations may be applied to the output of algorithm [2] and to the points 
provided by GCONTR to the line drawing subroutine for such purposes as 
coordinate system conversion. Note that neither algorithm [2] nor GCONTR 
require the grid lines to be straight or uniformly spaced. 
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ALGORITHM 
SUBROUTINE FILLO(BITMAP, N) FIL 10 
Cc FIL 20 
Cc FILL THE FIRST N BITS OF BITMAP WITH ZEROES. FIL 30 
Cc FIL 40 
INTEGER BITMAP(1), N FIL 50 
Cc FIL 60 
DATA NBPW /35/ FIL 70 
Cc NBPW IS THE MINIMUM NUMBER OF SIGNIFICANT BITS PER WORD USED FIL 80 
Cc BY INTEGER ARITHMETIC. THIS IS USUALLY ONE LESS THAN THE FIL 90 
Cc ACTUAL NUMBER OF BITS PER WORD, BUT AN IMPORTANT EXCEPTION IS FIL 100 
Cc THE CDC-6000 SERIES OF MACHINES, WHERE NBPW SHOULD BE 48. FIL 110 
Cc FIL 120 
LOOP = N/NBPW FIL 130 
NBLW = MOD(N,NBPW) FIL 140 
IF (LOOP.EQ.0) GO TO 20 FIL 150 
DO 10 I=1,LOOP FIL 160 
BITMAP(I) = 0 FIL 170 
10 CONTINUE FIL 180 
20 IF (NBLW.NE.O) BITMAP(LOOP+1) = MOD(BITMAP(LOOP+1) ,2**(NBPW-NBLW) FIL 190 
* ) FIL 200 
RETURN FIL 210 
END FIL 220 
SUBROUTINE MARK1 (BITMAP, N) MAR 10 
Cc MAR 20 
Cc PUT A ONE IN THE NTH BIT OF BITMAP. MAR 30 
Cc MAR 40 
INTEGER BITMAP(1), N MAR 50 
Cc MAR 60 
DATA NBPW /35/ MAR 70 
C NBPW IS THE MINIMUM NUMBER OF SIGNIFICANT BITS PER WORD USED MAR 80 
Cc BY INTEGER ARITHMETIC. THIS IS USUALLY ONE LESS THAN THE MAR 90 
C ACTUAL NUMBER OF BITS PER WORD, BUT AN IMPORTANT EXCEPTION IS MAR 100 
C THE CDC-6000 SERIES OF MACHINES, WHERE NBPW SHOULD BE 48. MAR 110 
Cc MAR 120 
NWORD = (N-1) /NBPW MAR 130 
NBIT = MOD(N--1,NBPW) MAR 140 
I = 2**(NBPW-NBIT-1) MAR 150 
BITMAP (NWORD+1) = BITMAP(NWORD+1) + I*(1-MOD(BITMAP(NWORD+1)/I,2) MAR 160 
* ) MAR 170 
RETURN MAR 180 
END MAR 190 
FUNCTION IGET(BITMAP, N) IGE 10 
c IGE 20 
Cc IGET=0 IF THE NTH BIT OF BITMAP IS ZERO, ELSE IGET IS ONE. IGE 30 
Cc IGE 40 
INTEGER BITMAP(1), N IGE 50 
Cc IGE 60 
DATA NBPW /35/ IGE 70 
Cc NBPW IS THE MINIMUM NUMBER OF SIGNIFICANT BITS PER WORD USED IGE 80 
Cc BY INTEGER ARITHMETIC. THIS IS USUALLY ONE LESS THAN THE IGE 90 
Cc ACTUAL NUMBER OF BITS PER WORD, BUT AN IMPORTANT EXCEPTION IS IGE 100 
Cc THE CDC-6000 SERIES OF MACHINES, WHERE NBPW SHOULD BE 48. IGE 110 
Cc IGE 120 


COLLECTED ALGORITHMS (cont.) 


AAQAAGRAAANQAAAGAAQAQGAANANQAUAAAQNAAQANQAKAAGANUGAANAAANANQGAANQGAAANNANARANQAANAARAQCANRaAaaqaagaananaaangnaanaanann 


NWORD = (N-1)/NBPW IGE 
NBIT = MOD(N-1,NBPW) IGE 
IGET = MOD(BITMAP (NWORD+1) /2** (NBPW-NBIT-1) , 2) IGE 
RETURN IGE 
END IGE 


SUBROUTINE GCONTR(Z, NWRZ, NX, MY, CV, NCV, ZMAX, BITMAP, DRAW) GCco 


Gco 

THIS SUBROUTINE DRAWS A CONTOUR THROUGH EQUAL VALUES OF AN ARRAY. GCO 
GCco 

kkeaKK FORMAL ARGUMENTS REAKAKAREKKEREEEKREEREEEEEREREREEERERERCCO 
GCo 

Z IS THE ARRAY FOR WHICH CONTOURS ARE TO BE DRAWN. THE ELEMENTS GCO 
OF Z ARE ASSUMED TO LIE UPON THE NODES OF A TOPOLOGICALLY GCco 
RECTANGULAR COORDINATE SYSTEM - E.G. CARTESIAN, POLAR (EXCEPT GCO 
THE ORIGIN), ETC. GCO 
GCO 

NRZ IS THE NUMBER OF ROWS DECLARED FOR Z IN THE CALLING PROGRAM. GCO 
Gco 

NX IS THE LIMIT FOR THE FIRST SUBSCRIPT OF Z. GCO 
GCco 

NY IS THE LIMIT FOR THE SECOND SUBSCRIPT OF Z. GCO 
GCO 

CV ARE THE VALUES OF THE CONTOURS TO BE DRAWN. GCO 
Gco 

NCV IS THE NUMBER OF CONTOUR VALUES IN CV. Gco 
GCO 

ZMAX IS THE MAXIMUM VALUE OF Z FOR CONSIDERATION. A VALUE OF GCO 
Z(I,J) GREATER THAN ZMAX IS A SIGNAL THAT THAT POINT AND THE GCOo 
GRID LINE SEGMENTS RADIATING FROM THAT POINT TO IT'S NEIGHBORS GCO 
ARE TO BE EXCLUDED FROM CONTOURING. GCO 
Gco 

BITMAP IS A WORK AREA LARGE ENOUGH TO HOLD 2*NX*NY*NCV BITS. IT GCO 
IS ACCESSED BY LOW-LEVEL ROUTINES, WHICH ARE DESCRIBED BELOW. GCO- 
LET J BE THE NUMBER OF USEFUL BITS IN EACH WORD OF BITMAP, GCO 
AS DETERMINED BY THE USER MACHINE AND IMPLEMENTATION OF GCco 
THE BITMAP MANIPULATION SUBPROGRAMS DESCRIBED BELOW. THEN GCO 
THE NUMBER OF WORDS REQUIRED FOR THE BITMAP IS THE FLOOR OF GCO 
(2*NX*NY*NCV+J-1) /J. GCO 

Gco 

DRAW IS A USER-PROVIDED SUBROUTINE USED TO DRAW CONTOURS. Gco 
THE CALLING SEQUENCE FOR DRAW IS: GCO 
GCO 

CALL DRAW (X,Y, 1FLAG) GCO 

LET NX = INTEGER PART OF X, FX = FRACTIONAL PART OF X. GCO 
THEN X SHOULD BE INTERPRETED SUCH THAT INCREASES IN NX GCO 
CORRESPOND TO INCREASES IN THE FIRST SUBSCRIPT OF Z, AND GCO 

FX IS THE FRACTIONAL DISTANCE FROM THE ABSCISSA CORRESPONDING GCO 

TO NX TO THE ABSCISSA CORRESPONDING TO NX+l, GCco 

AND Y SHOULD BE INTERPRETED SIMILARLY FOR THE SECOND GCO 
SUBSCRIPT OF Z. GCO 

THE LOW-ORDER DIGIT OF IFLAG WILL HAVE ONE CF THE VALUES: GCO 

1 - CONTINUE A CONTOUR, GCO 

2 - START A CONTOUR AT A BOUNDARY, GCO 

3 = START A CONTOUR NOT AT A BOUNDARY, GCO 

4 - FINISH A CONTOUR AT A BOUNDARY, GCO 

5 ~ FINISH A CLOSED CONTOUR (NOT AT A BOUNDARY). GCO 

NOTE THAT REQUESTS 1, 4 AND 5 ARE FOR PEN-DOWN Gco 

MOVES, AND THAT REQUESTS 2 AND 3 ARE FOR PEN-UP GCOo 

MOVES. GCO 

6 - SET X AND Y TO THE APPROXIMATE 'PEN' POSITION, USING GCO 

THE NOTATION DISCUSSED ABOVE. THIS CALL MAY BE GCO 

IGNORED, THE RESULT BEING THAT THE 'PEN' POSITION GCO 

IS TAKEN TO CORRESPOND TO Z(1,1). GCO 

IFLAG/10 IS THE CONTOUR NUMBER. GCo 

GCO 

REKKEK EXTERNAL SUBPROGRAMS RARKERKERAEREERKEREEERERREREEEREGCO 
GCO 

DRAW IS THE USER-SUPPLIED LINE DRAWING SUBPROGRAM DESCRIBED ABOVE.GCO 
DRAW MAY BE SENSITIVE TO THE HOST COMPUTER AND 7:0 THE PLOT DEVICE.GCO 
FILLO IS USED TO FILL A BITMAP WITH ZEROES. CALL FILLO (BITMAP,N)GCO 
FILLS THE FIRST N BITS OF BITMAP WITH ZEROES. GCO 
MARK1 IS USED TO PLACE A 1 IN A SPECIFIC BIT OF THE BITMAP. ~  G6CO 


CALL MARK] (BITMAP,N) PUTS A 1 IN THE NTH BIT O}' THE BITMAP. GCO 
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IGET IS USED TO DETERMINE THE SETTING OF A PARTICULAR BIT IN THE GCO 


AAAHAAAN 


aaana 


aaAaaAAaA 


QAaAaQa 


aan 


AAQAQAARQANRAANQAARARAaAaAa 


* 


10 


20 


BITMAP. I=IGET(BITMAP,N) SETS I TO ZERO IF THE NTH BIT OF THE. 
BITMAP IS ZERO, AND SETS I TO ONE IF THE NTH BIT IS ONE. 
FILLO, MARK] AND IGET ARE MACHINE SENSITIVE. 


GCO 


REKKAKKKEREKEAREKERAAEARERERERERKREERRERREREREREREEREREEEREREEREREEERERCGCO 


REAL Z(NRZ,1), CV(1) 
INTEGER BITMAP (1) 
INTEGER L1(4), L2(4), IJ(2) 


Ll AND L2 CONTAIN LIMITS USED DURING THE SPIRAL SEARCH FOR THE 
BEGINNING OF A CONTOUR. 

IJ STORES SUBCRIPTS USED DURING THE SPIRAL SEARCH. 

INTEGER I11(2), 12(2), 13(6) 


Il, I2 AND I3 ARE USED FOR SUBSCRIPT COMPUTATIONS DURING THB 
EXAMINATION OF LINES FROM Z(I,J) TO IT'S NEIGHBORS. 


REAL XINT(4) 


XINT IS USED TO MARK INTERSECTIONS OF THE CONTOUR UNDER 
CONSIDERATION WITH THE EDGES OF THE CELL BEING EXAMINED. 


REAL XY(2) 

XY IS USED TO COMPUTE COORDINATES FOR THE DRAW SUBROUTINE.. 

EQUIVALENCE (L2(1),IMAX), (L2(2),JMAX), (L2(3),IMIN), 
(L2(4) , JMIN) 

EQUIVALENCE (IJ(1),1), (IJ(2),J) 

EQUIVALENCE (XY¥(1),X), (X¥(2),¥) 


DATA L1(3) /-1/, L1(4) /-1/ 
DATA Il /1,0/, 12 /1,-1/, 13 /1,0,0,1,1,0/ 


L1(1) = NX 
L1(2) = NY 
DMAX = ZMAX. 


SET THE CURRENT PEN POSITION. THE DEFAULT POSITION CORRESPONDS 
TO Z(1,1). 


X = 1.0 

Y = 1.0 

CALL DRAW(X, Y, 6) 

ICUR = MAXO(1,MINO(INT(X) ,NX) ) 
JCUR = MAXO(1,MINO(INT(Y) ,NY)) 


CLEAR THE BITMAP 


CALL FILLO(BITMAP, 2*NX*NY*NCV) 


SEARCH ALONG A RECTANGULAR SPIRAL PATH FOR A LINE SEGMENT HAVING 


THE FOLLOWING PROPERTIES: 
1. THE END POINTS ARE NOT EXCLUDED, 
2. NO MARK HAS BEEN RECORDED FOR THE SEGMENT, 


3. THE VALUES OF Z AT THE ENDS OF THE SEGMENT ARE SUCH THAT 


ONE Z IS LESS THAN THE CURRENT CONTOUR VALUE, AND THE 
OTHER IS GREATER THAN OR EQUAL TO THE CURRENT CONTOUR 
VALUE. 


SEARCH ALL BOUNDARIES FIRST, THEN SEARCH INTERIOR LINE SEGMENTS. 


NOTE THAT THE INTERIOR LINE SEGMENTS NEAR EXCLUDED POINTS MAY BE 


BOUNDARIES . 


IDIR 
DIRECTION ZERO IS +I, 1 IS +J, 2 IS -I, 3 IS -J. 


a 
(o) 
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aaaa 


aang 


30 


40 


50 


60 


70 
80 


100 


110 


120 
130 


140 


150 


160 


170 


180 


190 


NXIDIR = IDIR + 1 

K = NXIDIR 

IF (NXIDIR.GT.3) NXIDIR = 0 

I = IABS(I) 

J = ITABS(J) 

IF (Z(I,J).GT.DMAX) GO TO 140 
L=l 

L=1 MEANS HORIZONTAL LINE, L=#2 MEANS VERTICAL LINE. 
IF (IJ(L).GE.L1(L)) GO TO 130 

II = I + I1(L) 

JJ = J + I1(3-L) 

IF (Z(II,JJ).GT.DMAX) GO TO 130 
ASSIGN 100 TO JUMP 

THE NEXT 15 STATEMENTS (OR SO) DETECT BOUNDARIES. 
Ix =1 

IF (IJ(3-L).EQ.1) GO TO 80 

II = I - I1(3-L) 

JJ = J - I1(L) 

IF (Z(1II,JJ).GT.DMAX) GO TO 70 
II = I + 12(L) 

JJ = J + 12(3-L) 

IF (Z(II,JJ).LT.DMAX) IX = 0 

IF (1J(3-L).GE.L1(3-L)) GO TO 90 
Il = I + I1(3-L) 

JJ = J + Il(L) 

IF (Z(II,JJ).GT.DMAX) GO TO 90 
IF (Z(I+1,J+1).LT.DMAX) GO TO JUMP, (100, 280) 
IX = IX + 2 

GO TO JUMP, (100, 280) 

IF (1IX.EQ.3) GO TO 130 

IF (IX+IBKEY.EQ.0) GO TO 130 


NOW DETERMINE WHETHER THE LINE SEGMENT IS CROSSED BY THE CONTOUR. 


II = I + I1(L) 
JJ = J + I1(3-L) 
Zl = Z2(I,J) 

22 = Z(II,JJ) 

DO 120 ICV=1,NCV 


IF (IGET (BITMAP, 2* (NX* (NY* (ICV-1)+J-1)+I-1)+L).NE.0) GO TO 120 


IF (CV(ICV) .LE.AMINI(Z1,Z2)) GO TO 110 
LF (CV(ICV) .LE.AMAX1(Z1,Z2)) GO TO 190 
CALL MARK1(BITMAP, 2%*(NX*(NY* (ICV-1)+J-1)+I-1)+L) 
CONTINUE 
L=L+1 
IF (L.LE.2) GO TO 50 
L = MOD(IDIR,2) + 1 
IJ(L) = ISIGN(IJ(L),L1(K)) 


LINES FROM Z(I,J) TO Z(I+1,J) AND Z(1I,J+1) ARE NOT SATISFACTORY. 


CONTINUE THE SPIRAL. 


IF (IJ(L).GE.L1(K)) GO TO 170 
IJ(L) = IJ(L) + 1 

IF (IJ(L).GT.L2(K)) GO TO 160 
GO TO 40 

L2(K) = IJ(L) 

IDIR = NXIDIR 

GO TO 30 

IF (IDIR.EQ.NXIDIR) GO TO 180 
NXIDIR = NXIDIR + 1 

IJ(L) = L1(K) 

K = NXIDIR 

L=3-1L 

IJ(L) = L2(K) 

IF (NXIDIR.GT.3) NXIDIR = 0 
GO TO 150 

IF (IBKEY.NE.0) RETURN 

IBKEY = 1 

GO TO 10 


AN ACCEPTABLE LINE SEGMENT HAS BEEN FOUND. 
FOLLOW THE CONTOUR UNTIL IT EITHER HITS A BOUNDARY OR CLOSES. 


TEDGE = L 

CVAL = CV(ICV) 

IF (IX.NE.1) IEDGE = IEDGE + 2 
IFLAG = 2 + IBKEY 


531-P 6- 


0 


COLLECTED ALGORITHMS (cont.) 


aAaaAaAaAN 
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aaa 


200 


210 


220 


230 


240 


250 


260 


270 


280 
290 


XINT(IEDGE) = (CVAL-Z1)/(Z2-Z1) 

XY(L) = FLOAT(IJ(L)) + XINT(IEDGE) 

XY(3-L) = FLOAT (IJ (3-L)) 

CALL MARKI1 (BITMAP, 2*(NX* (NY* (ICV-1)+J-1)+I-1)+L) 
CALL DRAW(X, Y, IFLAG+10*ICV) 

IF (IFLAG.LT.4) GO TO 210 


ICUR = I 
JCUR = J 
GO TO 20 


CONTINUE A CONTOUR. THE EDGES ARE NUMBERED CLOCKWISE WITH 
THE BOTTOM EDGE BEING EDGE NUMBER ONE. 


NI = 1 
IF (IEDGE.LT.3) GO TO 220 
I = I - I3(IEDGE) 
J = J - 13(IEDGE+2) 
DO 250 K=1,4 
IF (K.EQ.IEDGE) GO TO 250 


II = I + I3(K) 
JJ = J + I3(K+1) 
Z1 = Z(II,JJ) 

II = I + 13(K+1) 
JJ = J + 13(K+2) 
Z2 = Z(II,JJ) 


IF (CVAL.LE.AMIN1(Z1,Z2)) GO TO 250 
IF (CVAL.GT.AMAX1(Z1,Z2)) GO TO 250 
IF (K.EQ.1) GO TO 230 
IF (K.NE.4) GO TO 240 
ZZ = Z1 
Z1 = 22 
Z2 = ZZ 
XINT(K) = (CVAL-Z1) /(Z2-21) 
NI = NI +1 
KS = K 
CONTINUE 
IF (NI.EQ.2) GO TO 260 


THE CONTOUR CROSSES ALL FOUR EDGES OF THE CELL BEING EXAMINED. 
CHOOSE THE LINES TOP-TO-LEFT AND BOTTOM-TO-RIGHT IF THE 


GCO 
GCO 
GCO 


INTERPOLATION POINT ON THE TOP EDGE IS LESS THAN THE INTERPOLATIONGCO 
POINT ON THE BOTTOM EDGE. OTHERWISE, CHOOSE THE OTHER PAIR. THISGCO 


METHOD PRODUCES THE SAME RESULTS IF THE AXES ARE REVERSED. THE 
CONTOUR MAY CLOSE AT ANY EDGE, BUT MUST NOT CROSS ITSELF INSIDE 
ANY CELL. 


KS = 5 - IEDGE 
IF (XINT(3).LT.XINT(1)) GO TO 260 
KS = 3 - IEDGE 

IF (KS.LE.0) KS = KS + 4 


DETERMINE WHETHER THE CONTOUR WILL CLOSE OR RUN INTO A BOUNDARY 
AT EDGE KS OF THE CURRENT CELL. 


L = KS 
IFLAG = 1 


ASSIGN 280 TO JUMP 
IF (KS.LT.3) GO TO 270 


I = I + 13(KS) 
J = J + 13(KS+2) 
L = Ks - 2 


IF (IGET (BITMAP, 2* (NX* (NY* (ICV-1)+J-1)+I-1)+L).—£Q.0) GO TO 60 
IFLAG = 5 

GO TO 290 

IF (IX.NE.0) IFLAG = 4 

IEDGE = KS + 2 

IF (IEDGE.GT.4) IEDGE = IEDGE - 4 

XINT(IEDGE) = XINT(KS) 

GO TO 200 


END 


DIMENSION 2(51,51), C(10), WORK(1680) 

DIMENSION OF WORK IS LARGE ENOUGH TO CONTAIN 

2* (DIMENSION OF C)*(TOTAL DIMENSION OF Z) USEFUL BITS. SEE THE 
BITMAP ROUTINES ACCESSED BY GCONTR. 


GCO 
GCO 
GCO 
GCO 
GCO 
GCO 
GCO 
GCcOo 
GCO 
GCO 
GCO 
GCO 
GCO 
GCO 
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REAL MU 
EXTERNAL DRAW 
COMMON /CUR/ XCUR, YCUR 
DATA C(1), €(2), C(3), C(4), C(5) /3.05,3.2,3.5,3.50135,3.6/ 
DATA —- C(7), C(8), C(9), C(10) /3.766413,4.0,4.130149,5.0, 
* 10.0 
DATA NX /51/, NY /51/, NF /10/ 
DATA XMIN /-2.0/, XMAX /2.0/, YMIN /-2.0/, YMAX /2.0/, MU /0.3/ 
DX = (XMAX-XMIN) /FLOAT(NX-1) 
DY = (YMAX-YMIN) / FLOAT (NY-1) 
XCUR = 1.0 
YCUR = 1.0 
IF (MOD(NX,2).NE.0) YCUR = FLOAT(NY) 
IF (MOD(NY,2).NE.0) XCUR = FLOAT(NX) 
X = XMIN - DX 
DO 20 I=1,NX 
Y = YMIN - DY 
X = X + DX 
DO 10 J=l1,NY 
Y= Y + DY 
Z(I,J) = (1.0-MU)*(2.0/SQRT ( (X-MU) **2+Y**2)+(X-MU) **2+Y**2) 
* + MU*(2.0/SQRT((X+1.0-MU) **2+Y**2)+(X+1 .0-MU) **2+Y**2) 
CONTINUE 
CONTINUE 
CALL GCONTR(Z, 51, NX, NY, C, NF, 1.E6, WORK, DRAW) 
STOP 
END 


REAL Z(51,51), C(10), CVAL(10), MU 

INTEGER WORK(1680), L(10), CLAB(10) 

DIMENSION OF WORK IS LARGE ENOUGH TO CONTAIN 

2* (DIMENSION OF C)*(TOTAL DIMENSION OF Z) USEFUL BITS. SEE THE 
BITMAP ROUTINES ACCESSED BY GCONTR. 

EXTERNAL DRAW 

COMMON /GCTCOM/ XCUR, YCUR, XL, YL, CVAL, CLAB, NCH 

DATA C(1), C(2), C(3), C(4), C(5) /3.05,3.2,3.5,3.50135,3.6/ 
DATA C(6), C(7), C(8), C(9), C(10) /3.766413,4.0,4.130149,5.0, 


* 10.0/ 


10 
20 


30 


DATA L(1), L(2), L(3), L(4), L(5) /1LHA,1HB,1HC,1HD,1HE/ 
DATA L(6), L(7), L(8), L(9), L(10) /1HF,1HG,1HH,1HI,1HJ/ 
DATA NX /51/, NY /51/, NF /10/, NxG /5/, NYG /5/ 
DATA XMIN /-2.0/, XMAX /2.0/, YMIN /-2.0/, YMAX /2.0/, MU /0.3/ 
DATA XLEN /8.0/, YLEN /8.0/ 
INITIALIZE PLOTTING SUBROUTINES. 
CALL PLOTS 
DX = (XMAX-XMIN) / FLOAT (NX-1) 
DY = (YMAX-YMIN) /FLOAT(NY-1) 
XL = XLEN/FLOAT (NX) 
YL = YLEN/FLOAT(NY) 
XCUR = 1.0 
YCUR = 1.0 
IF (MOD(NX,2).NE.0) YCUR = FLOAT(NY) 
IF (MOD(NY,2).NE.0) XCUR = FLOAT(NX) 
X = XMIN - DX 
DO 20 I=1,NX 
Y = YMIN - DY 
X = X + DX 
DO 10 J=1,NY 
Y = Y + DY 
EVALUATE FUNCTION TO BE PLOTTED. 
Z(I,J) = (1.0-MU)*(2.0/SQRT ( (X—MU) **2+Y**2)+(X-MU) **2+Y**2) 
* + MU*(2.0/SQRT ((X+1.O-MU) **2+Y**2)+(X+1 .0-MU) **2+Y**2) 
CONTINUE 
CONTINUE 
DO 30 I=1,NF 
CVAL(I) = C(I) 
CLAB(I) = L(I) 
CONTINUE 
NCH = 1 
PEN UP MOVE TO BELOW LOWER LEFT CORNER OF PAGE. 
THIS CALL WORKS DIFFERENTLY ON DIFFERENT MACHINES. YOU MAY 
NEED TO CHANGE IT. 
CALL PLOT(0.0, -11.0, -3) 
PEN UP MOVE TO 1 INCH ABOVE LOWER LEFT CORNER OF PAGE. 
CALL PLOT(0.0, 1.0, -3) 
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aaQqna 


aa 


40 


10 


SX = 8.0/FLOAT(NXG) 
SY = 8.0/FLOAT (NXG) 
DRAW A GRID. 
CALL CGRID(1, NXG, SX, 0.0, 0.0, NYG, SY, 0.0, 0.0) 
DRAW THE CONTOUR PLOTS. 
CALL GCONTR(Z, 51, NX, NY, CVAL, NF, 1.0E6, WORK, DRAW) 
XX = 9.0 
YY = 8.0 
WRITE A TABLE OF CONTOUR LABELS AND VALUES. 
CALL SYMBOL(XX, YY+0.14, 0.07, lLOHCONTOUR ID, 0.0, 10) 
DO 40 I=1,NF 
CALL SYMBOL(XX, YY, 0.07, L(I), 0.0, 2) 
CALL NUMBER(XX+0.12, YY, 0.07, C(I), 0.0, 5) 
YY = YY - 0.14 
CONTINUE 
PEN UP MOVE TO BELOW LOWER RIGHT CORNER OF PAGE. 


THIS CALL WORKS DIFFERENTLY ON DIFFERENT MACHINES. YOU MAY NEED 


TO CHANGE IT, OR YOU MAY NOT NEED IT. 
CALL PLOT(10.0, -11.0, -3) 
REDUCE PICTURE SIZE, PLOT END OF FILE INFORMATION. 


THE END OF FILE INFORMATION MAY NOT BE AVAILABLE AT ALL SITES. 
IF NOT AVAILABLE, CHANGE THE NEXT TWO STATEMENTS TO COMMENTS. 


CALL FACTOR(0.3) 
CALL PLOT(0.0, 0.0, 999) 
STOP 


END 


SUBROUTINE DRAW(X, Y, IFLAG) 


THIS SUBROUTINE USES CALCOMP PLOT ROUTINES TO DRAW LINES FOR THE 


CONTOUR PLOTTING ROUTINE GCONTR. 

REAL CVAL(10) 

INTEGER CLAB(10) 

COMMON /GCTCOM/ XCUR, YCUR, XL, YL, CVAL, CLAB, NCH 
DATA IBLANK /1H / 

IH = IFLAG/10 

IL = IFLAG - 10*IH 

IF (IL.EQ.6) GO TO 40 

IPEN = 2 

IF (IL.EQ.2) IPEN = 3 

IF (IL.EQ.3) IPEN = 3 

XCUR = X 

YCUR = Y 

XX = (X-1.0)*XL 

YY = (Y-1.0)*YL 

CALL PLOT(XX, YY, IPEN) 

IF (IL.LT.2) GO TO 30 

IF (IL.GT.4) GO TO 30 

IF (NCH.LT.1) GO TO 30 

IF (CLAB(IH).EQ.IBLANK) GO TO 30 

IF (CLAB(IH).NE.0) GO TO 10 

CALL NUMBER(XX, YY-0.03, 0.07, CVAL(IH), 0.0, -1) 
GO TO 20 

CALL SYMBOL(XX, YY-0.03, 0.07, CLAB(IH), 0.0, NCH) 
CALL PLOT(XX, YY, 3) 

RETURN 

X = XCUR 

Y = YCUR 

RETURN 


END 


SUBROUTINE DRAW(X, Y, IFLAG) 
DO OUTPUT FOR GCONTR. 


INTEGER PRINT 

COMMON /CUR/ XCUR, YCUR 

DATA PRINT /6/ 

PRINT IS THE SYSTEM PRINTER FORTRAN I/O UNIT NUMBER. 
ICONT = IFLAG/10 

JUMP = MOD(IFLAG,10) 

GO TO (10, 20, 30, 40, 50, 60), JUMP 

WRITE (PRINT,99999) ICONT, X, Y 

GO TO 70 
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20 
30 
40 
50 


60 


70 
99999 
99998 
99997 
99996 
99995 
99994 


AOAAAARAAANQNAANAANARAAQANAAANAAANAaAAN 


aaa 


aaa 


10 


20 


30 


WRITE 
GO TO 
WRITE 
GO TO 
WRITE 
GO TO 
WRITE 
GO TO 
WRITE 


(PRINT, 99998) ICONT, X, Y 
70 
(PRINT,99997) ICONT, X, Y 
70 


(PRINT,99996) ICONT, X, Y 
70 

(PRINT,99995) ICONT, X, Y 
70 

(PRINT, 99994) 


X = XCUR 

Y = YCUR 

RETURN 

FORMAT (17H CONTINUE CONTOUR, 13, 3H TO, 1P2E14.7) 

FORMAT (14H START CONTOUR, I3, 19H ON THE BOUNDARY AT, 1P2E14.7) 
FORMAT (14H START CONTOUR, 13, 19H IN THE INTERIOR AT, 1P2E14.7) 
FORMAT (15H FINISH CONTOUR, 13, 19H ON THE BOUNDARY AT, 1P2E14.7) 
FORMAT (15H FINISH CONTOUR, 13, 19H IN THE INTERIOR AT, 1P2E14.7) 
FORMAT (33H REQUEST FOR CURRENT PEN POSITION) 


END 


SUBROUTINE CGRID(NOPT, NX, SX, XS, XF, NY, SY, YS, YF) 


XINC 
YINC 


SUBROUTINE WHICH DRAWS A FRAME AROUND THE PLOT AND DRAWS 
EITHER TICK MARKS OR GRID LINES. 


PARAMETERS: NOPT -- =0, DRAW TICKS ONLY 


=], DRAW GRID LINES 
=2, DRAW GRID LINES TO EDGE OF FRAME. 
NX -- NUMBER OF INTERVALS IN X DIRECTION 
SX -- SPACING IN INCHES BETWEEN TICK MARKS OR GRID LINES 
ALONG THE X AXIS 
XS -- LOCATION OF FIRST TICK OR GRID LINE ON X AXIS 
XF -- LOCATION OF RIGHT EDGE OF FRAME 
NY -- NUMBER OF INTERVALS IN Y DIRECTION 
SY -- SPACING IN INCHES BETWEEN TICK MARKS OR GRID LINES 
ALONG THE Y AXIS 
YS -- LOCATION OF FIRST TICK OR GRID LINE ON Y AXIS 
YF -- LOCATION OF TOP EDGE OF FRAME 


ASSUMPTIONS: NX, SX, NY, SY ALL POSITIVE. 


CGR 


THE LOWER LEFT-HAND CORNER OF THE FRAME IS DRAWN AT (0,0)CGR 


IF XS10, USE 0; IF ¥S10, USE 0 
IF XF1=0, USE NX*SX; IF YF1=0, USE NY*SY. 


= SX 
= SY 


XLGTH = FLOAT (NX)*SX 
YLGTH = FLOAT (NY) *SY 


XMIN 
YMIN 


CALL 
CALL 
CALL 
CALL 
CALL 
IF (N 


DRAW 


DO 12 
GO 
X2 
IF 
Y2 
GO 
XIN 
X2 
IF 


= AMAX1 (XS,0.0) 
= AMAX1(YS,0.0) 
= AMAX1 (XF,XLGTH+XMIN) 
= AMAX1 (YF, YLGTH+YMIN) 


FRAME. 


PLOT(0.0, 0.0, 3) 
PLOT (XMAX, 0.0, 2) 
PLOT (XMAX, YMAX, 2) 
PLOT(0.0, YMAX, 2) 
PLOT(0.0, 0.0, 2) 
OPT.NE.0) GO TO 130 


TICK MARKS. 


0 J=1,4 

TO (10, 50, 20, 40), J 

= 0.0 

(XMIN.NE.0.0) X2 = XMIN - SX 
= 0.0 

TO 30 

Cc = -SX 

= XMIN + XLGTH + SX 
(XMAX.EQ.XMIN+XLGTH) X2 = XMAX 
= YMAX 

Y2 

Y2 + SIGN(0.125,XINC) 


CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
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aaa 


40 


50 


60 


70 


80 


90 
100 


110 
120 


130 


140 


150 


160 
170 


180 


190 


200 


210 
220 


N = NX 
IF (ABS (XMAX-XMIN-XLGTH)+ABS(XMIN)) 70, 80, 70 
YINC = -SY 
Y2 = YMIN + YLGTH + SY 
IF (YMAX.EQ.YMIN+YLGTH) Y2 = YMAX 
X2 = 0.0 
GO TO 60 
Y2 = 0.0 
IF (YMIN.NE.O.0) Y¥2 = YMIN - SY 
X2 = XMAX 
Xl = X2 
N = NY 
X2 = X2 - SIGN(0.125,YINC) 

IF (ABS(YMAX-YMIN-YLGTH)+ABS(YMIN)) 70, 80, 70 
N=N+1 
DO 110 I=1,N 
IF (MOD(J,2).EQ.0) GO TO 90 
X2 = X2 + XINC 
Xl = X2 
Go TO 100 
Y2 = Y2 + YINC 
Yl = Y2 
CALL PLOT(X1, Yl, 3) 
CALL PLOT(X2, ¥2, 2) 
CONTINUE 
CONTINUE 
GO TO 240 


DRAW GRID LINES 


Xl = XMIN 

X2 = XMIN + XLGTH 

IF (NOPT.NE.2) GO TO 140 
Xl = 0.0 

X2 = XMAX 

Yl = YMIN - SY 

N=NY +1 


IF (YMAX.EQ.YMIN+YLGTH) N = N - 1 
IF (YMIN.NE.0.0) GO TO 150 
Yl = 0.0 
N=eN-1 
IF (N.LE.0) GO TO 170 
J=1 
DO 160 I=1,N 
J=-J 
Yl = Yl + SY 
CALL PLOT(X1, Yl, 3) 
CALL PLOT(X2, Yl, 2) 
XX = Xl 
Xl = X2 
X2 = XX 
CONTINUE 
Yl = YMIN + YLGTH 
Y2 = YMIN 
LF (NOPT.NE.2) GO TO 180 
Yl = YMAX 
Y2 = 0.0 
N= NX +1 
IF (J.LT.0) GO TO 200 
Xl = XMIN - SX 
IF (XMAX.EQ.XMIN+XLGTH) N= N - 1 
IF (XMIN.NE.0.0) GO TO 190 
Xl = 0.0 
N=N-1 
IF (N.LE.0) GO TO 240 
XINC = SX 
GO TO 220 
Xl = XMIN + XLGTH + Sx 
IF (XMIN.EQ.0.0) N= N-1 
IF (XMAX.NE.XLGTH+XMIN) GO TO 210 
N=eNn-1 
Xl = XMAX 
XINC = -SX 
DO 230 I=l,N 
Xl = Xl + XINC 
CALL PLOT(X1, Yl, 3) 


CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
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CGR 
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CGR 
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C 


CALL PLOT(X1, Y2, 2) 
XX = Yl 
Yl = Y2 
Y2 = XX 
230 CONTINUE 
240 RETURN 


END 


CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 
CGR 


1320 
1330 
1340 
1350 
1360 
1370 
1380 
1390 
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ALGORITHM 532 
Software for Roundoff Analysis [Z] 


WEBB MILLER 

University of California, Santa Barbara 
and 

DAVID SPOONER 

Pennsylvania State University 


Key Words and Phrases: automatic roundoff analysis, numerical stability, numerical linear algebra 
CR Categories: 5.10, 5.11, 5.14 
Language: Fortran 


DESCRIPTION 


This software package is a complement to [1] where its usage and performance 
are described. 


REFERENCES 


1. MILLER, W., AND SPOONER, D. Software for roundoff analysis, Il. ACM Trans. Math. Software 
4, 4 (Dec. 1978), 369-387. 


ALGORITHM 


NAME(n): indicates a Fortran module with n records 

NAME”: indicates test data for the minicompiler 

Contents for the minicompiler: DATA(570), MAIN(388), CODGEN (445), 
NEXT(12), CODOPT(148), INSERT(69), GETNAM (32), GETDIM(34), 
RDIM(51), ADD(114), STORE(69), GETVAL(88), SYMINT(39), LEXAN(422), 
GETSTM(343), KFIND(118), INTERP(322), REALOP(25), OPER(504), 
FINISH(203), ADDTMP(70), ADDSUB(51), ADDNAM(47), TERROR(58), 
ERROR(80), TERROR(95) 


Cc RHKKRKRKKKERRKRKERKEKKKAKERKEKK AAAHAASA 
Cc * * AAAAAL AA 
Cc * OVERVIEW * AAAAAISA 
Cc ® * AAAHA2AN 
Cc HKKKKKKRRERRERRRERERIRERIK AAAAA2 5A 
Cc AAAAA IAN 
Cc AANAAI5A 
C THIS PROGRAM IS A COMPILER WHICH TAKES AS DATA A PROGRAM WRITTEN ANAAALAA 
C IN A SIMPLE PROGRAMMING LANGUAGE ( A DESCRIPTION OF WHICH FOLLOWS) AAANALSA 
C AND PRODUCES AS OUTPUT A TRANSLATION OF THAT PROGRAM INTO A SERIES AHAAAS A 
C OF ASSIGNMENT STATEMENTS. THE STRAIGHT LINE CODE TRANSLATION IS AAAAA5S 5A 


Received 21 August 1975 and 4 March 1977. 

Permission to copy without fee all or part of this material is granted provided that the copies are not 
made or distributed for direct commercial advantage, the ACM copyright notice and the title of the 
publication and its date appear, and notice is given that copying is by permission of the Association 
for Computing Machinery. To copy otherwise, or to republish, requires a fee and/or specific 
permission. 

This work was supported in part by NSF Grants GJ-42968 and MCS 76-13561A01. 

Authors’ addresses: W. Miller, Department of Mathematics, University of California, Santa Barbara, 
Santa Barbara, CA 93106; D. Spooner, Department of Computer Science, 303 Whitmore Laboratory, 
Pennsylvania State University, University Park, PA 16802. 

© 1978 ACM 0098-3500/78/1200-0388 $00.75 
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AAAGAAAAANQAAANANRANRANANAANAANKGaANDNAANANAN HAAN AMMA AN an AAn AANA AAAAO ANQNAAANAANAAAAANAGA 


one) 


i WED EL Bo 


PRINTED IN A READABLE FORM FOR THE COMPILER USER AND ALSO PUNCHED 

IN A CODED FORM FOR USE AS INPUT TO ANY OF SEVERAL ROUNDOFF ERROR 
ANALYSIS PROGRAMS OF WEBB MILLER. 

THE MAIN ROUTINE OF THE COMPILER IS AN LL-1 PARSING ROUTINE. IT 
CALLS THE LEXICAL ANALYZER TO PRODUCE INTERNAL TOKENS BY SCANNING 
THE SOURCE CODE. THE PARSER ALSO CALLS THE ROUTINE CODGEN WHICH 
PRODUCES INTERMEDIATE CODE FOR THE INTERPRETER AND WHICH PERFORMS 
SOME SYNTAX CHECKING AND OTHER PERIPHERAL FUNCTIONS NECESSARY 

FOR PARSING. 

WHEN THE ENTIRE INPUT HAS BEEN SCANNED AND PARSED, THE INTERPRETING 
ROUTINES ARE ACTIVATED. THESE INTERPRET THE INTERMEDIATE CODE AND 
GENERATE THE FINAL STRAIGHT LINE PRINTED AND PUNCHED OUTPUT. DURING 
INTERPRETATION, ALL INTEGER EXPRESSIONS ARE ACTUALLY EVALUATED IN 
ORDER TO PERFORM THE CORRECT NUMBER OF ITERATIONS OF EXPLICIT FOR- 
LOOPS AND OF FOR-LOOPS IMPLICIT IN SUMMATION EXPRESSIONS, AND TO 
INTERPRETIVELY PERFORM IF-THEN TESTS. IN CONTRAST, NO ACTUAL 

REAL ARITHMETIC COMPUTATION IS DONE. THROUGHOUT, ALL REAL 
VARIABLES ARE TREATED SYMBOLICALLY AS BEING THE N-TH INPUT VALUE, 
INTERMEDIATE VALUE, OR REAL CONSTANT. 

BOTH THE LEXICAL ANALYZER AND THE INTERPRETER COMPRISE SEVERAL SUB- 
ROUTINES.IN ADDITION THERE ARE COLLECTIONS OF SYMBOL TABLE ROUTINES, 
ERROR ROUTINES AND ROUTINES TO PRINT AND PUNCH THE COMPILER'S 
OUTPUT. 

IF ANY ERRORS ARE ENCOUNTERED DURING PARSING, THE PARSER CONTINUES 
TO CHECK FOR SYNTAX ERRORS, BUT NO FURTHER INTERMEDIATE CODE WILL BE 
GENERATED, AND NO INTERPRETATION WILL TAKE PLACE. SIMILARLY, IF 
EXECUTION ERRORS ARE IDENTIFIED DURING INTERPRETATION, NO STRAIGHT 
LINE CODE WILL BE EITHER PRINTED OR PUNCHED. 


KRKKAKKKEKRKEKKERKKEEKRERKERKAKRKEKKKKRKKKKKK 


* * 
* THE SOURCE LANGUAGE * 
* * 


KRHEKKEKEREREREREKRERKEERKEEKRKEKRERKKKKKRKR KKK 


THE LANGUAGE TO BE COMPILED IS A SIMPLE LANGUAGE DESIGNED FOR 
CODING NUMERICAL ALGORITHMS. IT BASICALLY INCLUDES REAL ASSIGN- 


MENT STATEMENTS, DIMENSION STATEMENTS AND SOME BLOCK STRUCTURE 
IMPOSED BY FOR-LOOPS, AND IF-THEN TESTS. THERE ARE NC MIXED-MODE 


AAAAHE AA 
AAAAHESH 
NAH 7TH 
HAAHAT SA 
HAMAD BOM 
AADDABSA 
AAAAKIAA 
AAAHAD 5A 
HAA LANA 
APAAIASA 
AAAALIAD 
AAAD1154 
AAAAI ING 
AAAH1250 
ADANHL 30AA 
AAHAL35A0 
AAAAILAD 
AAAAILSA 
AAAI SAN 
AAAHIS SA 
AAAI EAN 
AAAKLESA 
AANA] TAA 
MAHAL T5A 
AHAAL BAN 
AAAAL RSA 
AAAHLOAA 
AAAALI5SA 
AAD 
AAAHIASA 
AHAN2IAN 
AAHA21SA 
NOAA 2A 
ADHA2250 
ANAH2 300 
ADDA2 350 
ADAH2LAN 
ADAD2450 
AAAH2 SAA 
AAHAH25 5A 
AAAA26AD 


ARTTHMETIC EXPRESSIONS, AND NO STATEMENT LABELS. INTEGER EXPRESSIONSAG002654 


AND VARTABLES ARE USED ONLY FOR DIMENSIONING REAL ARRAYS, FOR 
DEFTNING BOUNDS IN FOR-LOOPS AND SUMMATION EXPRESSION LOOPS, AND FOR 
VARIABLES TO BE TESTED IN IF-THEN STATEMENTS, 

THE CARD FORMAT IS SIMILAR TO FORTRAN. STATEMENTS APPEAR 
IN COLUMNS 7-72, AND A 1 IN COLUMN 6 INDICATES CONTINUATION. A 
C IN COLUMN 1 INDICATES A COMMENT. 

THERE ARF SEVEN STATEMENT TYPES, BRIEFLY DESCRIBED BELOW: 


1. THE TEST STATEMENT 


USE: TO ASSIGN VALUES TO INTEGER VARIABLES WHICH WILI. THEMSELVES 
BE USED TO DIMENSTON REAL ARRAYS. 


FORM: TEST(I1,12,13,...) 


WHERE FACH I IS AN ASSTGNMENT STATEMENT OF THE FORM 
INTEGER VARIABLE = INTEGER CONSTANT. 


2. THE DIMENSION STATEMENT 


USE: TO ASSIGN DIMENSIONS TO ARRAYS. THE ARRAY NAME MAY BE 
EITHER A DEFAULT REAL OR INTEGER IDENTIFIER. ITS USE IN 
THE DIMENSION STATEMENT CONSTITUTES AN IMPLICIT REAL 


DECLARATION. 
FORM: DIMENSION(D1,D2,D3 ..) 
WHERE EACH D IS OF ONE OF THE FOLLOWING FORMS: 
IDENTIFIER(T) 
IDENTIFIER(11,12) 


AND FACH I IS AN INTEGER VARIABLE OR INTEGER CONSTANT. 


NOTE: DIMENSION AND TEST STATEMENTS ARE NON-EXECUTABLE AND MUST 
PRECEED ALL EXECUTABLE STATEMENTS. IN ADDITION, AN INTEGER 


AAAAZ TAN 
AAAHIT5A 
AAHN2 BAN 
ADGGH2850 
ANAA2IPA 
AAAH295A 
AAAAZAAA 
ADAAZASA 
AAAHZIAA 
AAAH3Z15% 
AAAHI2NA 
AAAAZ25A 
AAAH3 300 
AAAKZ35H 
AAAH3ILAN 
AAAAIZL5SA 
AAAKHZ50AA 
AAAAZ55A 
AAAAZ6AA 
AAAA3I65A 
AGAAZ7ON 
AAHAI75A 
AOAA3ZBON 
ADAAZ850 
ADAA3IAN 
AANA395H 
APADALAAA 
APDAH4ASD 
600064100 
AADAL15@ 
AOHAHL2ANA 
ADDAL250 
DDADS 300 
APAAL 350 
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VARIABLE APPEARING IN A DIMENSION STATEMENT MUST BE ASSIGNED A AGGA4400 


AAAQANINNIAAARQRAAAAAAAGAAAAAARAARAAARAANRANANAANAARAANAANAANRANAANANAAN ANDANANAAN AANANANAMDAANAAN ANA A AMAAANNAANAANAAAAANA 


VALUE IN A PRECEEDING TEST STATEMENT. ANAKRLLSA 
AADHL SAN 

3. THE INPUT/OUTPUT STATEMENTS AAAALS 5M 
AAAAL EAN 

USE: TO NOTIFY THE COMPILER THAT CERTAIN VALUES WILL BE SUPPLIED Adaq465¢ 
BY THE PROGRAMMER AS INITIAL VALUES FOR REAL VARIABLES WHEN 44444700 

THE STRAIGHT LINE CODE IS USED AS INPUT FOR A ROUNDOFF FRRORAAAAG75A 
ANALYSIS; OR THAT CERTAIN REAT. VARIABLES ARE EXPECTED TO AAAKL BAA 
RECEIVE VALUES AS A RESULT OF RUNNING THE PROGRAM BEING AAAKLBSA 
COMPILED. AMAA IDA 
APAAGI5A 
FORM: INPUT(D1,D2,D3,...) AHAASAAA 
OUTPUT(D1,D2,D3,..) AAAASASA 
AGAAS LAA 
EACH D IS EITHER THE NAME OF A REAL SCALAR, A SINGLE ARRAY 0045154 
ELEMENT, OR AN ENTIRE ARRAY. IN THE LATTER CASE THE ARRAY 40005200 
WILL BE INPUT(OUTPUT) IN COLUMN MAJOR ORDER. APAHS 250 
NOTE THAT ONLY VALUES WHICH ARE THE RESULT OF A AAAAS 300 
COMPUTATION MAY BE OUTPUT. CONSTANTS OR DATA VALUES ANANS 350 
MAY NOT BE OUTPUT. PAAAS LAA 
ADOOH5450 
4, THE REAL ASSIGNMENT STATEMENT AAHAS SAA 
ADADS SSA 
USE: TO ASSIGN A VALUE TO A REAT, VARIABLE AAAS GAA 
AAHHASESA 
FORM: REAL VARIABLE # REAL EXPRESSION AAHAS TAA 
AAHAS 750 
WHERE THE REAL VARIABLE IS EITHER A REAL SCALAR OR SINGLE aAdAASaAA 
ARRAY ELEMENT. REAL EXPRESSIONS ARE MADE UP OF REAL PADASB5SA 
VARIABLES AND CONSTANTS COMBINED WITH THE BINARY OPERATORS AAAASOMA 
+, -, * AND / AND THE UNARY OPERATORS UNARY - AND SQRT. AAAASI5A 

oe OPERAND OF THE SQRT MUST APPEAR IN PARENTHESES. ) 00 6A 

NOTE THAT THERE IS NO REAL EXPONENTIATION ALLOWED. ) 605 
OPERATOR PRECEDENCE IS AS IN STANDARD FORTRAN. IN ADDITION AAAH6100 
THERE IS A SUMMATION OPERATION ON ARRAY VECTORS, IN EFFECT, 90006150 
A BUILT-IN INNER PRODUCT. A SUMMATION EXPRESSION CAN APPEARAHG006 2060 
IN A REAL EXPRESSION AND IS OF THE FORM: ADNN6 250 
ADAG 306A 
SUMMATION(D1 * D2, SUMMATION-VARIABLE = INTEXP1 TO INTEXP2) 06000635 
ADHDDE4AG 

WHERE INTEXP IS AN INTEGER EXPRESSION, THE SUMMATION ADAHESSO 
VARIABLE IS ANY INTEGER IDENTIFIER NAME, AND WHERE D1 AND D2600H6500 
ARE EACH OF ONE OF THE FORMS: ANADESSA 
ARRAY NAMF.(SUMMATTON-VARIABLE) AAAAEEAN 
ARRAY NAME(SUMMATION-VARIABLE, SUMMATION-VARIABLE) APANEH5A 
ARRAY NAME(SUMMATION-VARIABLE, INTEXP) AAANG TAN 
ARRAY NAME (INTEXP, SUMMATTON-VARIABLE) NAAN TSA 
AGAKESAN 
A SUMMATION EXPRESSION WILL BE INTERPRETED AS AN TMPLICIT &@ANAG685A 
FOR-LOOP. ANY USE OF THE SUMMATION VARIABLE IN THE INTEGER AdAH69AN 
EXPRESSIONS BOUNDING THE SUMMATION LOOP WILL BE FLAGGED AS AdAgK95A 
AN ERROR. AAAAT AAA 
AAAATASA 
THE FOR STATEMENT AAAAT LAA 
AADK7 150 

USE: AS A MEANS OF INDICATING THAT A BLOCK OF STATEMENTS IS TO BEAAAA7T2AN 
ITERATIVELY EXECUTED A SPECIFIED NUMBER OF TIMES. AAAAT25A 

PADHAT 300 

FORM: FOR INTEGER-VARIABLE = INTEXP] TO INTEXP2 BY INCREMENT AADNT 350 
APAATLAD 

WHERE INTEXP STANDS FOR INTEGER EXPRESSION, AND INCREMENT 1S00007450 
WRITTEN AS EITHER +1, -1 OR 1. 00007500 
NADA7T550 

INTERPRETATION: ALL STATEMENTS UP TO THE END STATEMENT MATCHING 00007600 
THIS FOR STATEMENT (SEE BELOW FOR DISCUSSION OF END 00007650 
STATEMENTS) WILL BE ITERATIVELY INTERPRETED AS IN A FORTRAN (0007700 

DO LOOP, EXCEPT THAT NEGATIVE INCREMENTS ARE ALLOWED AND IN 00007750 

THIS CASE, THE LOOP VARTABLE TEST IS DONE AT THE TOP OF THE #0007800 

LOOP. THUS, EMPTY LOOPS ARE POSSIBLE, THAT IS THOSE WHICH 4007850 

WILL NOT BE EXECUTED AT ALL. (NOTE THE SAME TS TRUE OF THE #4007900 
IMPLICIT FOR-LOOP IN A SUMMATION EXPRESSION. ) ADAATI5A 
AAAABAAA 

6. THE IF-THEN STATEMENT AAAABASA 
AAAABLAA 

USE: TO ALLOW SELECTIVE EXECUTION OF A BLOCK OF STATEMENTS ADANE150 
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IAANAAAANRANANAANAAANANAANANANAANANAANANANANNAANANAN MANA NAMA AnN MANDAN KMN AAA AMAM AAO 


AAANAANRQRIAANR A 


DEPENDING ON THE OUTCOME OF A COMPARISON OF THE VALUES OF daAaang2AnN 

TWO INTEGER EXPRESSIONS. AAAAB25A 

ADAH IA 

FORM: IF INTEXP1 .R. INTEXP2 THEN AAANR 35M 
AAAHBLHD 

WHERE INTEXP STANDS FOR INTEGER EXPRESSION AND R IS ONE OF (0008450 

THE RELATIONS WRITTEN EQ,NE,GT,LT,LE OR GE WITH THE APAABSAD 
STANDARD FORTRAN DENOTATION. NOTE THAT THERE ARE NO 09008550 
PARENTHESES AROUND THE RELATIONAL EXPRESSION. PADABEAD 
00008650 

INTERPRETATION: IF THE TEST SUCCEEDS, THAT IS IF THE TWO INTEGER 0008700 
EXPRESSIONS ARE RELATED IN THE INDICATED WAY AT THE TIME OF A0#08750 
INTERPRETATION, THEN ALL THE STATEMENTS UP TO THE NEXT END aaAam88A0 
STATEMENT WILL BE INTERPRETED. OTHERWISE, THE FIRST AAAHBBSA 
EXECUTABLE STATEMENT FOLLOWING THE NEXT END) STATEMENT WILL aaaa89a0 

BE THE NEXT STATEMENT INTERPRETED. AAAABIS5A 
AAAAIAAA 

. THE END STATEMENT AAAAIASA 
AAAAD LAA 

USE: TO DEFINE THE ENDS OF BLOCKS OF STATEMENTS BEGINNING WITH AAAN9154 
FOR STATEMENTS OR IF-THEN STATEMENTS. AAAAD 2A 

AAAAG 250 

FORM1: END AAHAAY 3h 
FORM2 : END(INTEGER-VARIABLE) AAAAI 350 
ADAAIGAA 

MEANING: WHEN FORM 1 IS USED THE EFFECT IS TO CLOSE THE BLOCK OF #009450 
STATEMENTS BEGINNING AT THE NEAREST PRECEEDING FOR OR AAAAI500 
IF-THEN STATEMENT. APAAI5 SA 

WHEN FORM2 IS USED THE EFFECT IS TO CLOSE THE FOR BLOCK APDAIEAA 
WHOSE LOOP VARIABLE MATCHES THE END STATEMENT VARIABLE. IN 0009650 
ADDITION, ANY FOR OR IF-THEN BLOCKS WHICH BEGIN BETWEEN THISA@AH9700 

END STATEMENT AND ITS MATCHING FOR STATEMENT ARE CLOSED. AAAHI750 

THIS INTERPRETATION IMPOSES STANDARD FORTRAN LIKE NESTING 0009800 
CONVENTIONS ON FOR AND IF-THEN BLOCKS. THAT IS, A SEQUENCE 00009850 

OF STATEMENTS APHAIIAD 

FOR K = IEl TO IE2 BY 1 AGON9950 

AADIDAAA 

? ADDLOASA 

FOR I = IE3 TO IE4 BY 1 AAAIAIAA 

AAAIALSA 

: AAALA2AN 

END (K) ADAIA2I5SA 

: AAAIAZAA 

END (I) ADALAI5A 

WILL RESULT IN AN ERROR MESSAGE WHEN THE END(1L) STATEMENT Aaa1AGAN 

IS ENCOUNTERED, BECAUSE BOTH FOR STATEMENTS WILL HAVE BEEN AQ1N454 
CLOSED BY THE PARSER WHEN THE END(K) STATEMENT WAS PARSED. ‘“AMA1A50A0 
ADALASSA 

NOTE: ADDITIONAL RESTRICTIONS ON BLOCK STRUCTURES: AAALAEAA 
1) AT MOST EIGHT FOR AND/OR IF-THEN BLOCKS CAN BF BEGUN ADHINESA 
BEFORE AN END STATEMENT OCCURS. AAAIATAA 

2) A FOR LOOP VARIABLE CANNOT BE USED AGAIN AS AN EXPLICIT 0010750 

FOR LOOP VARIABLE WITHIN ITS ORIGINAL LOOP. IT CAN BE AAAIABAA 

REUSED AS A SUMMATION VARIABLE, HOWEVER. ANHIABSA 

ADALAIAA 

APHA1HI5A 

8. THE STOP STATEMENT APALIAAA 
ADA1LIASA 

USE: TO DENOTE THE END OF THE PROGRAM 10011190 
00611150 

FORM: *STOP ADAL 120 
HAATI250 


Contents of program comparing rounding error in a single algorithm with 
perturbations of the problem: MAIN1(372), F(64), ROUND(116), 
GETRHO(64), OMEGA(76) 


THE USER SUPPLIES: 


THE OUTPUT FROM THE MINICOMPILER. 


THE ENTRIES OF THE INITIAL SET OF DATA. 


ONE ENTRY PER CARD, EACH 


ENTRY WRITTEN WITH A DECIMAL POINT AND CONTAINED IN THE FIRST 
TWENTY COLUMNS. 


THE CHOICE OF OMEGA (+) OR RHO (-). 


FORMAT (12). 


69000050 


96000100 
99000150 
06006200 
66000256 
00000300 
$9000350 
00000460 
096060456 


99000500 
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AND ANAAKNAANANAQNDANANANANNNDANQANDGDANQANQAAANAAQAAANDAAANANANANQAANAAGAAAANAARAANAANRNKNDANAANAAMNANANANAANAANAAAAA 


THE 


SQRT AND UNARY MINUS ARE ENCODED AS 1-6, RESPECTIVELY. SQRT AND 
UNARY MINUS REQUIRE @ AS THEIR SECOND OPERAND. 
’ THE NUMBER OF OUTPUTS OF THE STRAIGHT-LINE PROGRAM. 
GE.1 AND LE.2@. FORMAT(I2) 
THE INSTRUCTIONS AT WHICH THE OUTPUTS ARE COMPUTED. FORMAT(13). 
THE NUMBER OF CONSTANTS. LE.2@. FORMAT(I2). 
THE CONSTANTS. FORMAT (G2¢.16) 
THE NUMBER OF ENTRIES IN A SET OF DATA. LE.3@. FORMAT(I2). 


: PERTURBATIONS 

1 : IN THE DATA, MEASURED COMPONENT-WISE. 

$2 : IN THE DATA AND RESULT, MEASURED COMPONENT-WISE. 
@3 : IN THE DATA, MEASURED NORM-WISE. 

$4 : IN THE DATA AND RESULT, MEASURED NORM-WISE. 


THE STOPPING VALUE FOR THE MAXIMIZER. WRITTEN WITH A DECIMAL 
POINT AND CONTAINED IN THE FIRST TWENTY COLUMNS OF ITS CARD. 


SOFTWARE RETURNS: 

AN ANNOTATED LISTING OF THE USER-SUPPLIED INFORMATION, PLUS THE 
ERROR-COMPARING VALUE, THE CONSTRAINT VALUES (IF ANY) AND 

THE OUTPUT COMPUTED AT THE INITIAL SET OF DATA. 

A LIST OF SELECTED VALUES FOUND BY THE MAXIMIZER. 

THE FINAL SET OF DATA. 


IF INSTABILITY IS DIAGNOSED, THEN ALL, ARITHMETIC OPERATIONS 
AT THE FINAL SET OF DATA ARE LISTED. 


OTHER INFORMATION IS RETURNED IF EXCEPTIONS ARISE. 


THE USER CAN AVOID THE MINICOMPILER BY SUPPLYING: 


THE NUMBER OF OPERATIONS IN THE PROGRAM BEING TESTED. GE.1 
AND LE.20@. FORMAT(I3). (INSTRUCTIONS ARE PROVIDED BELOW FOR 


RAISING THE UPPER BOUND TO TEST LONGER PROGRAMS, OR LOWERING IT 


TO CONSERVE STORAGE.) 
THE OPERATIONS OF THE STRAIGHT-LINE PROGRAM, 


1¢¢ + J AND THE K-TH CONSTANT AS -K. 


THIS MAIN PROGRAM PERFORMS INPUT AND OUTPUT DUTIES. 


THE SUBPROGRAMS ARE: 


MAXIM - A 'DIRECT SEARCH' NUMERICAL MAXIMIZER CALLED BY THE 
MAIN PROGRAM. 


GRAM - A GRAM-SCHMIDT ROUTINE USED BY MAXIM. 


F -— FUNCTION CALLED BY MAXIM WHICH EVALUATES THE PENALIZED 
ERROR-COMPARING VALUE. 


ROUND - ROUTINE CALLED BY THE MAIN PROGRAM AND F TO EVALUATE 
SENSITIVITY TO ERRORS. 


GETRHO ~ ROUTINE CALLED BY ROUND IF THE USER OPTS TO TEST RHO 
INSTEAD OF OMEGA. 


OMEGA ~ ROUTINE CALLED BY ROUND TO EVALUATE OMEGA. 

GENEIG, REDUC, TRED1, TRIDIB - ROUTINES TO COMPUTE THE 
EIGENVALUES FOR OMEGA. THE USER MAY NEED TO USE DIFFERENT 
VERSIONS OF THE EISPACK ROUTINES. 


POSITV - USER-SUPPLIED ROUTINE TO EVALUATE CONSTRAINTS. 


FORMAT (13,12,14). 
THE I-TH DATA ENTRY IS ENCODED AS I, THE J-TH COMPUTED VALUE AS 
THE OPERATIONS +, -, *, /, 


06000556 
09000600 
00000656 
66600700 
00000756 
06000800 
$6000850 
00000900 
09000950 
60601600 
00061050 
$00611060 
00001156 
06001206 
000901250 
0960013066 
$9001350 
00061406 
00001450 
$00601500 
$400155¢ 
00001600 
060601650 
00001760 
90001750 
00001800 
000901850 
20001900 
00001950 
00062000 
90002050 
$9002100 
90002150 
90002200 
$606225¢ 
00002300 
00062350 
$0002400 
00002456 
$9002500 
00002550 
$0002600 
90002650 
00062700 
00002750 
$6002800 
00062850 


00003100 
$000315¢ 
00063200 
09003250 
09003300 
00003350 
10003400 
00003456 
00003500 
00003550 
$0003600 
06003650 
09003706 
00003756 
00003800 
90003850 
00003900 
096063950 
000040600 
$0004050 
00004100 
00004150 
00004200 
00004250 
09004 300 
00004350 
09004400 
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Contents of program comparing rounding errors in two algorithms: 
MAIN2(854), F(64), ROUND(111), GETRHO(36), OMEGA(40) 


Cc 00006050 
C THE USER SUPPLIES: 90900100 
C $0000150 
Cc THE OUTPUT FROM THE MINICOMPILER FOR EACH OF THE TWO 90000200 
Cc ALGORITHMS BEING TESTED. 60000250 
C 909000300 
C THE ENTRIES OF THE INITIAL SET OF DATA. ONE ENTRY PER CARD, EACH $0060350 
Cc ENTRY WRITTEN WITH A DECIMAL POINT AND CONTAINED IN THE FIRST $0066400 
Cc TWENTY COLUMNS. 90000450 
Cc 09000560 
Cc THE CHOICE OF OMEGA (+) OR RHO (-). FORMAT(I2). $6000556 
Cc CODE : COMPARE 60000600 
Cc @1 : (ALGORITHM 1) / (ALGORITHM 2) 0000656 
G @2 : (ALGORITHM 2) / (ALGORITHM 1) 69900700 
Cc 09000750 
Cc THE STOPPING VALUE FOR THE MAXIMIZER. WRITTEN WITH A DECIMAL 00006800 
c POINT AND CONTAINED IN THE FIRST TWENTY COLUMNS OF ITS CARD. 69000856 
Cc 00600900 
C THE SOFTWARE RETURNS: 99000950 
C 00001060 
C AN ANNOTATED LISTING OF THE USER-SUPPLIED INFORMATION, PLUS THE 00001650 
G ERROR-COMPARING VALUE, THE CONSTRAINT VALUES (IF ANY) AND 90001100 
Cc THE OUTPUT COMPUTED AT THE INITIAL SET OF DATA. 00001150 
C 96001200 
c A LIST OF SELECTED VALUES FOUND BY THE MAXIMIZER. 06001256 
c $6001300 
C THE FINAL SET OF DATA. 60061350 
Cc 99001400 
C OTHER INFORMATION IS RETURNED IF EXCEPTIONS ARISE. 66001450 


Contents required by both the above rounding error packages and the data for 
the minicompiler: LISTOP(38), MAXIM(109), GRAM(38), GENEIG(44), 
REDUC(119), TRED1(118), TRIDIB(272), MDATA? (279) 


c 90061500 
C nr = —— 9991 5.58 
c 0900 1600 
C THE USER CAN AVOID THE MINICOMPILER BY SUPPLYING: 00001650 
Cc 66001700 
c THE NUMBER OF OPERATIONS IN THE PROGRAM BEING TESTED. GE.1 $0001750 
Cc AND LE.206. FORMAT(I3). (INSTRUCTIONS ARE PROVIDED BELOW FOR 06001800 
Cc RAISING THE UPPER BOUND TO TEST LONGER PROGRAMS, OR LOWERING IT  $090185¢ 
Cc TO CONSERVE STORAGE.) 96901900 
Cc $0001950 
Cc THE OPERATIONS OF THE STRAIGHT-LINE PROGRAM. FORMAT(I3,12,14). 0002000 
Cc THE I-TH DATA ENTRY IS ENCODED AS I, THE J-TH COMPUTED VALUE AS  $60692065¢ 
Cc 16@ + J AND THE K~TH CONSTANT AS -K. THE OPERATIONS +, -, *, /, 06002100 
Cc SQRT AND UNARY MINUS ARE ENCODED AS 1-6, RESPECTIVELY. SQRT AND $0060215¢ 
re UNARY MINUS REQUIRE @ AS THEIR SECOND OPERAND. $00022060 
Cc $90002250 
Cc THE NUMBER OF OUTPUTS OF THE STRAIGHT-LINE PROGRAM. 96002300 
Cc GE.1 AND LE.2¢. FORMAT(I2) $9002 356 
Cc 00002400 
Cc THE INSTRUCTIONS AT WHICH THE OUTPUTS ARE COMPUTED. FORMAT(I3). $600245¢ 
€ 00002500 
Cc THE NUMBER OF CONSTANTS. LE.2@. FORMAT(I2). 000625506 
Cc 00002600 
€ THE CONSTANTS. FORMAT(G2@.16) 00002656 
Cc 00002700 
Cc THE NUMBER OF ENTRIES IN A SET OF DATA. LE.3@. FORMAT(I2). $0062750 
Cc GO002800 
Co penne nnn ann nnn nn nnn nnn nnn nnn nnn nnn nnn nnn 09002850 
Cc $000 29060 
C THIS MAIN PROGRAM PERFORMS INPUT AND OUTPUT DUTIES. $006295¢ 
Cc 09003000 
C THE SUBPROGRAMS ARE: 000030656 
Cc $6003100 
Cc MAXIM - A ‘DIRECT SEARCH' NUMERICAL MAXIMIZER CALLED BY THE $600315¢ 
Cc MAIN PROGRAM. $0003 200 
Cc $0003250 
¢ GRAM - A GRAM-SCHMIDT ROUTINE USED BY MAXIM. $0003360 
C 96003350 
Cc F - FUNCTION CALLED BY MAXIM WHICH EVALUATES THE PENALIZED $000 34060 
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ERROR-COMPARING VALUE. 


ROUND - ROUTINE CALLED BY THE MAIN PROGRAM AND F TO EVALUATE 
SENSITIVITY TO ERRORS. 


GETRHO - ROUTINE CALLED BY ROUND IF THE USER OPTS TO TEST RHO 
INSTEAD OF OMEGA. 


OMEGA ~— ROUTINE CALLED BY ROUND TO EVALUATE OMEGA. 

GENEIG, REDUC, TRED1, TRIDIB ~ ROUTINES TO COMPUTE THE 
EIGENVALUES FOR OMEGA. THE USER MAY NEED TO USE DIFFERENT 
VERSIONS OF THE EISPACK ROUTINES. 


POSITV ~- USER-SUPPLIED ROUTINE TO EVALUATE CONSTRAINTS. 


90003450 
$600 3500 
00003550 
00003600 
$9063650 
96003700 
00063750 
00003800 
$6003850 
00003900 
$0063956 
060040600 
900064050 
00004100 
00004150 
00004 200 
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ALGORITHM 533 

NSPIV, A Fortran Subroutine for Sparse 
Gaussian Elimination With Partial 
Pivoting [F4] 


ANDREW H. SHERMAN 
The University of Texas at Austin 


Key Words and Phrases: sparse Gaussian elimination, sparse linear systems, linear equations, 
partial pivoting algorithms 

CR Categories: 5.14 

Language: Fortran 


DESCRIPTION 
1. Introduction 


NSPIV is a Fortran subroutine which solves a sparse system of linear equations 
Ax = 6b 


by sparse Gaussian elimination with partial pivoting. More precisely, it performs 
Gaussian elimination with column interchanges on the nonsingular N x N matrix 
A to effectively obtain a factorization of the form 


AQ=LU, 


where L is lower triangular, U is unit upper triangular, and Q is a permutation 
matrix corresponding to the column interchanges. To conserve storage, only the 
factor U is retained, so during elimination, operations are performed on the right- 
hand side to obtain the solution y of the system. 


Ly=b. 
Once U has been obtained, x is computed by solving the upper triangular system 


UQ'*x=y. 


This algorithm discusses the usage of NSPIV and gives a few test results. The 
method used in NSPIV is described in [7], where it is called “run insertion”; [7] 
also includes extensive test results which show NSPIV to be more efficient than 
other currently available software for sparse Gaussian elimination with pivoting. 
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2. Usage 


For a description of the calling sequence and matrix storage schemes used, see 
the listing presented here. 

The actual numerical computations are performed in an internal subroutine 
NSPIV1, which is written to perform all computations in single precision. Con- 
version to double precision may be accomplished simply by changing REAL 
declarations to DOUBLE PRECISION declarations in both NSPIV and NSPIVI1, 
and by changing the calls to ABS into calls to DABS. 

It is well known that the initial ordering of the rows of A greatly affects the 
overall performance of a subroutine like NSPIV (cf. [1, 7]). To provide initial row 
and column orderings to NSPIV, the user must set the arrays R, C, and IC so 
that R(J) is the number of the Jth row in the row ordering, C(J) is the number 
of the 7th column in the column ordering, and JC(C(J)) = J for all J. (Notice that 
no modifications are required to the arrays, IA, JA, and A.) It is always assumed 
by NSPIV that the user has provided initial row and column orderings; if the 
orderings are unchanged from those of A, then the user should set R(Z) = C(J) 
=IC(I) =I. 

Often, sparse linear systems arise with a natural band structure in which all of 
the nonzeros of A are clustered near the main diagonal. On such problems, with 
a poor initial ordering, NSPIV may perform worse than some widely available 
subroutines for band Gaussian elimination with partial pivoting. However, for a 
sparse matrix A with a given row ordering, NSPIV will often require less storage 
and not too much more computation time than a band subroutine. Moreover, it 
is usually possible to find easily computed row orderings for which NSPIV is 
substantially more efficient than a band subroutine would be with a good band- 
reducing ordering. 

To illustrate these remarks, we consider a sample problem which could arise in 
the numerical solution of partial differential equations. Here A is a 10 X 10 block 
tridiagonal matrix 


N 


B D 
A= B 
Oe 
B 
with the 10 X 10 blocks given by 
3. —5 - 
O . 
oe eee OC 


C= 7 = , B=D= 
SS © 


—-15 3. } 


We solved this problem using NSPIV with three different initial row orderings: 
the natural ordering (NO) in which the problem was presented, the so-called 
alternate diagonal ordering (ADO) (cf. Price and Coats [6]), and an ordering in 
which the sparsest rows are ordered first (SO). We also solved the problem using 
the subroutine LEQT1B from the IMSL library ([4]) using the natural ordering 
to produce the smallest possible bandwidth for this problem (cf. George [3]). 
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Table I 
Subroutine Ordering Solution Time* Total Storage 
SPIV So .799 4785 
SPIV ADO .146 2453 
SPIV NO .283 3181 
LEQTIB NO .244 3300 


* Times are in seconds. Programs were run on a CDC-6600 computer using 
the MNF Fortran compiler. 


Our results are summarized in Table I. With the SO ordering, NSPIV required 
much more storage and time than LEQT1B did with the natural ordering. With 
identical orderings, LEQT1B was slightly faster than NSPIV, but NSPIV required 
less storage and also saved both the input matrix A and the right-hand side 6 in 
their original forms. (LEQT1B does save both triangular factors, however.) 
Finally, with the ADO ordering, NSPIV used substantially less storage and 
computation time than LEQTIB. It should be noted in passing that the SO 
ordering apparently works quite well on problems without the natural band 
structure present in this example (cf. [1, 7]), even though it did not do well here. 
Also, experiments indicate that more complex orderings such as the minimum 
degree or modified Markowitz orderings (cf. Sherman [8]) may be used to good 
advantage with NSPIV. 
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ALGORITHM 


NAME(n): indicates a Fortran module with n records 

NAME’: indicates “NAME?” is included for testing purposes 

NAME”: _ indicates “NAME” contains test data 

Contents: NSPIV(108), NSPIV1(275), MAIN’(62), PREORD'"(35), 
RESCHK"™(28), PIVCHK"™(35), GENPRB"(37), DATA?(960) 


SUBROUTINE NSPIV (N,IA,JA,A,B,MAX,R,C,IC,X, ITEMP,RTEMP, [ERR) 1 
Cc 2 
C 3 
C NSPIV CALLS NSPIV1 WHICH USES SPARSE GAUSSIAN ELIMINATION WITH 4 
C COLUMN INTERCHANGES TO SOLVE THE LINEAR SYSTEM A X = B. THE 5 
C ELIMINATION PHASE PERFORMS ROW OPERATIONS ON A AND B TO OBTAIN 6 
C A UNIT UPPER TRIANGULAR MATRIX U AND A VECTOR Y. THE SOLUTION 7 
C PHASE SOLVES U X= Y. 8 
C 9 
Cc 10 
C INPUT ARGUMENTS--- 11 
C 12 
Cc ON INTEGER NUMBER OF EQUATIONS AND UNKNOWNS 13 
C 14 
Co vTk INTEGER ARRAY OF N+l ENTRIES CONTAINING ROW POINTERS TO A 15 
Cc (SEE MATRIX STORAGE DESCRIPTION BELOW) 16 
C 17 
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JA 


Ic 


ITEMP 


RTEMP 


OUTPUT 


C 


Ic 


TERR 


INTEGER ARRAY WITH ONE ENTRY PER NONZERO IN A, CONTAINING 
COLUMN NUMBERS OF THE NONZEROES OF A. (SEE MATRIX STORAGE 
DESCRIPTION BELOW) 


REAL ARRAY WITH ONE ENTRY PER NONZERO IN A, CONTAINING THE 
ACTUAL NONZEROES. (SEE MATRIX STORAGE DESCRIPTION BELOW) 


REAL ARRAY OF N ENTRIES CONTAINING RIGHT HAND SIDE DATA 


INTEGER NUMBER SPECIFYING MAXIMUM NUMBER OF OFF-DIAGONAL 
NONZERO ENTRIES OF U WHICH MAY BE STORED 


INTEGER ARRAY OF N ENTRIES SPECIFYING THE ORDER OF THE 
ROWS OF A (I.E., THE ELIMINATION ORDER FOR THE EQUATIONS) 


INTEGER ARRAY OF N ENTRIES SPECIFYING THE ORDER OF THE 
COLUMNS OF A. C IS ALSO AN OUTPUT ARGUMENT 


INTEGER ARRAY OF N ENTRIES WHICH IS THE INVERSE OF C 
(I.E., IC(C(1)) = I). IC IS ALSO AN OUTPUT ARGUMENT 


INTEGER ARRAY OF 2*N + MAX + 2 ENTRIES, FOR INTERNAL USE 


REAL ARRAY OF N + MAX ENTRIES FOR INTERNAL USE 


ARGUMENTS~-— 


INTEGER ARRAY OF N ENTRIES SPECIFYING THE ORDER OF THE 
COLUMNS OF U. C IS ALSO AN INPUT ARGUMENT 


INTEGER ARRAY OF N ENTRIES WHICH IS THE INVERSE OF C 
(I.E., IC(C(I)) = 1). I¢€ IS ALSO AN INPUT ARGUMENT 


REAL ARRAY OF N ENTRIES CONTAINING THE SOLUTION VECTOR 
INTEGER NUMBER WHICH INDICATES ERROR CONDITIONS OR 

THE ACTUAL NUMBER OF OFF-DIAGONAL ENTRIES IN U (FOR 
SUCCESSFUL COMPLETION) 


IERR VALUES ARE--- 


@ LT IERR SUCCESSFUL COMPLETION. U HAS IERR 
OFF-DIAGONAL NONZERO ENTRIES 

IERR = @ ERROR. N= 9 

-N LE IERR LT @ ERROR. ROW NUMBER IABS(IERR) OF A IS 
IS NULL 


-2*N LE IERR LT -N ERROR. ROW NUMBER IABS(IERR+N) HAS A 
DUPLICATE ENTRY 


-3*N LE TERR LT -2*N ERROR. ROW NUMBER IABS(IERR+2*N) 
HAS A ZERO PIVOT 


-4*N LE IERR LT -3*N ERROR. ROW NUMBER IABS (IERR+3*N) 
EXCEEDS STORAGE 


STORAGE OF SPARSE MATRICES--- 


THE SPARSE MATRIX A IS STORED USING THREE ARRAYS IA, JA, AND A. 
THE ARRAY A CONTAINS THE NONZEROES OF THE MATRIX ROW-BY-ROW, NOT 
NECESSARILY IN ORDER OF INCREASING COLUMN NUMBER. THE ARRAY JA 
CONTAINS THE COLUMN NUMBERS CORRESPONDING TO THE NONZEROES STORED 
IN THE ARRAY A (I.E., IF THE NONZERO STORED IN A(K) IS IN 

COLUMN J, THEN JA(K) = J). THE ARRAY IA CONTAINS POINTERS TO THE 
ROWS OF NONZEROES/COLUMN INDICES IN THE ARRAY A/JA (I.E., 


A(IA(1))/JA(IA(I)) IS THE FIRST ENTRY FOR ROW I IN THE ARRAY A/JA). 
TA(N+1) IS SET SO THAT IA(N+1) - IA(1) = THE NUMBER OF NONZEROES IN A 


REAL AC(L),B(1),X(1),RTEMP(1) 
INTEGER IA(1),JACL),RCI),C(1),1C(1), [ITEMP(1) 
INTEGER IU,JU,U,Y,P 
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C 
C 
C 


~ 
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SET INDICES TO DIVIDE TEMPORARY STORAGE FOR NSPIV1 


Y= 1 
U= Y+N 

p= | 

IU P+N+ 1 
JU = IU +N + 1 


CALL NSPIVI ‘TO PERFORM COMPUTATIONS 


GALL NSPIVI (N,IA,JA,A,B,MAX,R,C, LC,X,RTEMP(Y) , 1TEMP(P), 
C I'TEMP (TU), [TEMP (JU) , RTEMP(U) , TERR) 
RETURN 
END 

SUBROUTINE NSPIVL (N,TA,JA,A,B,MAX,R,C, IC,X,Y,P,1U, JU,U, LERR) 


NSPIV1 USES SPARSE GAUSSIAN ELIMINATION WITH 

COLUMN INTERCHANGES TO SOLVE THE LINEAR SYSTEM A X = B. THE 
ELIMINATION PHASE PERFORMS ROW OPERATIONS ON A AND B TO OBTAIN 
A UNIT UPPER TRIANGULAR MATRIX U AND A VECTOR Y. THE SOLUTION 
PHASE SOLVES U X = Y. 


SEE NSPIV FOR DESCRIPTIONS OF ALL INPUT AND OUTPUT ARGUMENTS 
OTHER THAN THOSE DESCRIBED BELOW 


INPUT ARGUMENTS (USED INTERNALLY ONLY) --- 


Y REAI, ARRAY OF N ENTRIES USED TO COMPUTE THE UPDATED 
RIGHT HAND SIDE 


P INTEGER ARRAY OF N+l1 ENTRIES USED FOR A LINKED LIST. 
P(N+1) IS THE LIST HEADER, AND THE ENTRY FOLLOWING 
P(K) IS IN P(P(K)). THUS, P(N+1) IS THE FIRST DATA 
ITEM, P(P(N+1)) IS THE SECOND, ETC. A POINTER OF 
N+1 MARKS THE END OF THE LIST 


TU INTEGER ARRAY OF N+l1 ENTRIES USED FOR ROW POINTERS TO U 
(SEE MATRIX STORAGE DESCRIPTION BELOW) 


JU INTEGER ARRAY OF MAX ENTRIES USED FOR COLUMN NUMBERS OF 
THE NONZEROES IN THE STRICT UPPER TRIANGLE OF U. (SEE 
MATRIX STORAGE DESCRIPTION BELOW) 


U REAL ARRAY OF MAX ENTRIES USED FOR THE ACTUAL NONZEROES IN 
THE STRICT UPPER TRIANGLE OF U. (SEE MATRIX STORAGE 
DESCRIPTION BELOW) 


STORAGE OF SPARSE MATRICES--- 


THE SPARSE MATRIX A IS STORED USING THREE ARRAYS IA, JA, AND A. 
THE ARRAY A CONTAINS THE NONZEROES OF THE MATRIX ROW-BY-ROW, NOT 
NECESSARILY IN ORDER OF INCREASING COLUMN NUMBER. THE ARRAY JA 
CONTAINS THE COLUMN NUMBERS CORRESPONDING TO THE NONZEROES STORED 
IN THE ARRAY A (1.E., IF THE NONZERO STORED IN A(K) IS IN 

COLUMN J, THEN JA(K) = J). THE ARRAY 1A CONTAINS POINTERS TO THE 
ROWS OF NONZEROES/COLUMN INDICES IN THE ARRAY A/JA (I1.E., 


A(IA(I))/JA(IA(1)) IS THE FIRST ENTRY FOR ROW I IN THE ARRAY A/JA). 
IA(N+1) IS SET SO THAT IA(N+1) - IA(1) = THE NUMBER OF NONZEROES IN 
A. IU, JU, AND U ARE USED IN A SIMILAR WAY TO STORE THE STRICT UPPER 


TRIANGLE OF U, EXCEPT THAT JU ACTUALLY CONTAINS C(J) INSTEAD OF J 


REAL A(1),B(1),U(1),X(1), YC) 

REAL DK,LK1, ONE, XPV, XPVMAX, YK, ZERO 

INTEGER C(1),1A(1),1C(1),1U(1), JAC), JU(1),P(1) ,RC1) 
INTEGER CK,PK,PPK,PV,V,VI,VJ,VK 


IF (N .EQ. 0) GO TO 10601 


ONE = 1.4 
ZERO = 0.0 
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C INITIALIZE WORK STORAGE AND POINTERS TO JU 
C 
DO 10 J=1,N 
X(J) = ZERO 
1d CONT LNUE 
Ludi) = 1 
JUPTR = @ 
C 
C PERFORM SYMBOLIC AND NUMERIC FACTORIZATION ROW BY ROW 
C VK (VI,VJ) IS THE GRAPH VERTEX FOR ROW K (I,J) OF U 
C 
DO 174 K=1,N 
C 
C INITLALIZE LINKED LLST AND FREE STORAGE FOR THIS ROW 
C THE R(K)-TH ROW OF A BECOMES THE K-TH ROW OF U. 
Cc 
P(N+1) = N+l 
VK = R(K) 
C 
C SET UP ADJACENCY LIST FOR VK, ORDERED IN 
C CURRENT COLUMN ORDER OF U. THE LOOP INDEX 
C GOES DOWNWARD TO EXPLOIT ANY COLUMNS 
C FROM A IN CORRECT RELATIVE ORDER 
Cc 
JMIN = IA(VK) 
JMAX = IA(VK+1) - 1 
IF (JMIN .GT. JMAX) GO TO 10602 
J = JMAX 
20 JAJ = JACI) 
VJ = IC(JAS) 
C 
C STORE A(K,J) LIN WORK VECTOR 
C 
X(VJ) = ACJ) 
C THIS CODE INSERTS VJ INTO ADJACENCY LIST OF VK 
PPK = N+1 
30 PK = PPK 
PPK = P(PK) 
IF (PPK - VJ) 30, 1003,4@ 
4Q P(VJ) = PPK 
P(PK) = VJ 
J=J-1 
IF (J .GE. JMIN) GO TO 26 
C 
C THE FOLLOWING CODE COMPUTES THE K-TH ROW OF U 
Cc 
VI = N+l 
YK = B(VK) 
50 V1 = P(VI) 
IF (VL .GE. K) GO TO 110 
C 
C VI LT VK -- PROCESS THE L(K,I) ELEMENT AND MERGE THE 
C ADJACENCY OF VI WITH THE ORDERED ADJACENCY OF VK 
Cc 
LKI = = X(VI) 
X(VI) = ZERO 
Cc 
C ADJUST RIGHT HAND SIDE TO REFLECT ELIMINATION 
C 
YK = YK + LKI * Y(VI) 
PPK = VI 
JMIN = IU(VI) 
JMAX = IU(VI+1) - 1 
IF (JMIN .GT. JMAX) GO TO 5@ 
DO 16¢@ J=JMIN, JMAX 
JUJ = JUCJ) 
VJ = IC(JUJ) 
Cc 
C LIF VJ IS ALREADY IN THE ADJACENCY OF VK, 
C SKIP THE INSERTION 
C 
IF (X(VJ) .NE. ZERO) GO TO 9¢ 
C 
C INSERT VJ IN ADJACENCY LIST OF VK. 
C RESET PPK TO VI IF WE HAVE PASSED THE CORRECT 
C INSERTION SPOT. (THIS HAPPENS WHEN THE ADJACENCY OF 


246 
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C VI IS NOT IN CURRENT COLUMN ORDER DUE TO PIVOTING.) 
C 
IF (VJ - PPK) 60,9¢, 70 
60 PPK = VI 
70 PK = PPK 
PPK = P(PK) 
IF (PPK - VJ) 74,90, 8@ 
80 P(VJ) = PPK 
P(PK) = VJ 
PPK = VJ 


COMPUTE L(K,J) = L(K,J) - L(K,I)*U(I,J) FOR L(K,1I) NONZERO 
COMPUTE U*(K,J) = U*(K,J) - L(K,L)*U(I,J) FOR U(K,J) NONZERO 
(U*(K,J) = U(K,J)*D(K,K)) 


AAQIAAA 


90 X(VJ) = X(VJ) + LKI * U(J) 
100 CONTINUE 
GO TO 5@ 


PIVOT--INTERCHANGE LARGEST ENTRY OF K-TH ROW OF U WITH 
THE DIAGONAL ENTRY. 


FIND LARGEST ENTRY, COUNTING OFF-DIAGONAL NONZEROES 


QaAaAaNgNgAAN 


110 IF (VI .GT. N) GO TO 1004 
XPVMAX = ABS(X(VI)) 
MAXC = VI 
NZCNT = @ 
PV = VI 
12@ V= PV 
PV = P(PV) 
IF (PV .GT. N) GO TO 13@ 
NZCNT = NZCNT + 1 
XPV = ABS(X(PV)) 
IF (XPV .LE. XPVMAX) GO TO 120 
XPVMAX = XPV 
MAXC = PV 
MAXCL = V 
GO TO 12¢ 
13¢ IF (XPVMAX .EQ. ZERO) GO TO 1604 


C IF VI = K, THEN THERE IS AN ENTRY FOR DIAGONAL 
C WHICH MUST BE DELETED. OTHERWISE, DELETE THE 

C ENTRY WHICH WILL BECOME THE DIAGONAL ENTRY 
C 


IF (VI .EQ. K) GO TO 14@ 
IF (VI .EQ. MAXC) GO TO 14@ 
P(MAXCL) = P(MAXC) 


GO TO 15¢@ 
146 VI = P(VI) 
C 
C COMPUTE D(K) = 1/L(K,K) AND PERFORM INTERCHANGE. 
C 


15@ DK = ONE / X(MAXC) 
X(MAXC) = X(K) 
I = C(K) 
C(K) = C(MAXC) 
C(MAXC) = I 
CK = C(K) 
IC(CK) = K 
IC(I) = MAXC 
X(K) = ZERO 


UPDATE RIGHT HAND SIDE. 
Y(K) = YK * DK 
C 
C COMPUTE VALUE FOR IU(K+1) AND CHECK FOR STORAGE OVERFLOW 
C 


IU(K+1) = LU(K) + NZCNT 
IF (IU(K+1) .GT. MAX+1) GO TO 195 


MOVE COLUMN INDICES FROM LINKED LIST TO JU. 
COLUMNS ARE STORED IN CURRENT ORDER WITH ORIGINAL 
COLUMN NUMBER (C(J)) STORED FOR CURRENT COLUMN J 


OaAagan 


247 
248 
249 
250 
251 
252 
253 
254 
255 
256 
257 
258 
259 
260 
261 
262 
263 
264 
265 
266 
267 
268 
269 
270 


. 2721 


272 
273 
274 
275 
276 
277 
278 
279 
280 
281 
282 
283 
284 
285 
286 
287 
288 
289 
290 
291 
292 
293 
294 
295 
296 
297 
298 
299 
300 
301 
302 
303 
304 
305 
306 
307 
308 
309 
31¢ 
311 
312 
313 
314 
315 
316 
317 
318 
319 
320 
321 
322 
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IF (VI .GT. N) GO TO 17@ 
J = VI 
16¢ JUPTR = JUPTR + 1 
JU(JUPTR) = C(J) 
U(JUPTR) = X(J) * DK 
X(J) = ‘ZERO 
J = P(J) 
IF (J .LE. N) GO TO 160 
17 CONTINUE 


Cc 
C BACKSOLVE U X = Y, AND REORDER X TO CORRESPOND WITH A 
Cc 
K=N 
DO 26@ I=1,N 
YK = Y(K) 
JMIN = LU(K) 
JMAX = IU(K+1) - 1 
IF (JMIN .GT. JMAX) GO TO 19¢ 
DO 186 J=JMIN, JMAX 
JUJ = JU(J) 
JUS = IC(JUJ) 
YK = YK - U(J) * Y(JUJ) 
18¢ CONTINUE 
19¢ Y(K) = YK 
CK = C(K) 
X(CK) = YK 
K = K-l 
2060 CONT INUE 
Cc 
C RETURN WITH IERR = NUMBER OF OFF-DIAGONAL NONZEROES IN U 
c 
IERR = IU(N+1) - IU(1) 
RETURN 
Cc 
C ERROR RETURNS 
Cc 
Cc N=@ 
c 
1001 IERR = @ 
RETURN 
Cc 
C ROW K OF A IS NULL 
Cc 
1002 IERR = -K 
RETURN 
Cc 


C ROW K OF A HAS A DUPLICATE ENTRY 
Cc 
1003 IERR = —(N+K) 
RETURN 
Cc 
C ZERO PIVOT IN ROW K 
Cc 
1604 LERR = -—(2*N+K) 
RETURN 
Cc 
C STORAGE FOR U EXCEEDED ON ROW K 
Cc 
1905 IERR = -(3*N+K) 
RETURN 
END 


APPENDIX A 


The code in this appendix illustrates the use of NSPIV. The linear system is of 


the form 


Ax=b 


where A is a 10 X 10 block tridiagonal matrix with 10 x 10 blocks. 


Specifically, 


This example is chosen for its simplicity; it does not exercise the algorithm, since 


A is a strictly diagonally dominant matrix. 
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with 


QAQMQANANAAANANANAANNA 


aan 


PROGRAM PIVCHK (OUTPUT, TAPE6=OUTPUT) 


THIS PROGRAM ILLUSTRATES THE USE OF NSPIV BY SOLVING THE 
SYSTEM OF LINEAR EQUATIONS 


AX=B8B 


WITH A AN NG X NG BLOCK TRIDIAGONAL MATRIX, WITH NG X NG BLOCKS. 
THE DIAGONAL BLOCKS OF A ARE: LOWER BI-DIAGONAL (ENTRIES ARE 4.@ 
ON THE DIAGONAL, -1.@ ON THE SUBDIAGONAL), AND THE OFF-DIAGONAL 
BLOCKS OF A ARE DIAGONAL (ENTRIES ARE -1.@ IN THE LOWER TRIANGLE, 
-1.5 IN THE UPPER TRIANGLE.) X IS CHOSEN TO BE A VECTOR 

OF ALL ONES, AND B IS COMPUTED ACCORDINGLY. 


INTEGER IA(161) ,JA(4Q0) ,R( 160) ,C(1006) , 1C (100) , ITEMP (597) 
REAL A(40) ,B(100) ,X(100) , RTEMP (495) 
DATA MAX/395/,NG/106/,N/100/ 


SET UP PROBLEM 


K= 1 

IA(1) = 1 

IAPTR = 1 

DO 5 I=1,NG 

DO 5 J=1,NG 

BK = @. 
IF (I .EQ. 1) GO TO l 
JACIAPTR) = K —- NG 
A(IAPTR) = -1. 
BK = BK - l. 


IAPTR = IAPTR + 1 

IF (J .EQ. 1) GO TO 2 
JA(IAPTR) = K- 1 
A(IAPTR) = -l. 

BK = BK - l. 


ON AOU RWN Ee 
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ana 


ana 


101 


aaan 


Qa 


10 


26 


30 


4Q 


Ci oo OF 


IAPTR = IAPTR + 1 
JACIAPTR) = K 
ACIAPTR) = 4. 

BK = BK + 4, 

IAPTR = IAPTR + 1 
IF (I .EQ. NG) GO TO 4 
JACIAPTR) = K + NG 
ACIAPTR) = -1.5 

BK = BK - 1.5 
IAPTR = IAPTR + 1 
B(K) = BK 
K=K+1 

IA(K) = IAPTR 
CONTINUE 


CALL PREORD(N,IA,R,C, IC) 


CALL NSPIV TO SOLVE SYSTEM 


CALL PREORD TO ORDER ROWS OF A BY INCREASING NUMBERS OF NONZEROES 


CALL NSPIV(N,IA,JA,A,B,MAX,R,C,1C,X, ITEMP, RTEMP, IERR) 


WRITE (6,101) IERR 
FORMAT (8H IERR = ,11) 


CALL RESCHK(N,IA,JA,A,B,X) 


STOP 
END 


SUBROUTINE PREORD(N,IA,R,C,IC) 


INTEGER IA(1),R(1),C(1),1C(1) 


pO 1 I=1,N 
R(I) =I 
c(I) =I 
Ic(I) =I 
CONTINUE 

po 5 I = 1,N 
C(I) = @ 


DO 1¢ K = 1,N 
KDEG = IA(K+1) - IA(K) 
IF (KDEG .EQ. @) KDEG = KDEG + 1 
IC(K) = C(KDEG) 
C(KDEG) = K 
CONTINUE 
l= 6 
DO 30 J = 1,N 
IF (C(J) .EQ. 6) GO TO 3 
K = C(J) 
IT=I+1 
R(I1) = K 
K = IC(K) 
IF (K .GT. 0) GO TO 2@ 
CONTINUE 
DO 4@ I = 1,N 
C(t). = 1 
IC(I) = 1 
CONTINUE 
RETURN 
END 
SUBROUTINE RESCHK(N,1IA,JA,A,B,X) 


INTEGER IA(1),JA(1) 
REAL A(1),B(1),X(1) 


CALL RESCHK TO COMPUTE MAX-NORM AND 2-NORM OF RESIDUAL 


PREORD ORDERS THE ROWS OF A BY INCREASING NUMBER OF NONZEROES. 
THE ROW PERMUTATION IS RETURNED IN R. 


C IS SET TO THE IDENTITY. 


RESCHK COMPUTES THE MAX-NORM AND 2-NORM OF THE RESIDUAL. 
DOUBLE PRECISION IS USED FOR THE COMPUTATION. 


DOUBLE PRECISION RESID,RESIDM,ROWSUM 


RESID = @. 
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19 


20 


25 


30 


QAAMQAAANANANAAAND 


aaa 


RESIDM = @. 
DO 2@ I=1,N 
ROWSUM = DBLE(B(I)) 
JMIN = IA(I) 
JMAX = IA(I+l) - 1 
DO 10 J=JMIN, JMAX 
JAJ = JA(J) 
ROWSUM = ROWSUM - DBLE(A(J)) * DBLE(X(JAJ)) 
CONTINUE 
IF (DABS (ROWSUM) .GT. RESIDM) RESIDM = DABS (ROWSUM) 
RESID = RESID + ROWSUM**2 
CONTINUE 
RESID = DSQRT(RESID) 
WRITE (6,25) RESID 
FORMAT (22H 2-NORM OF RESIDUAL = ,D14.7) 
WRITE (6,3@) RESIDM 
FORMAT (24H MAX NORM OF RESIDUAL = ,D14.7) 
RETURN 
END 


PROGRAM PIVCHK (INPUT , OUTPUT , TAPE6=OUTPUT , TAPE5=INPUT) 


THIS PROGRAM ILLUSTRATES THE USE OF NSPIV BY SOLVING THE 
SYSTEM OF LINEAR EQUATIONS 


A X=B 
WHERE A IS A BANDED 192 X 192 MATRIX OF BANDWIDTH 2@. xX IS 
CHOSEN TO BE A VECTOR OF ALL ONES, AND B IS COMPUTED ACCORDINGLY. 


INTEGER IA(193) ,JA(3506@) ,R(192) ,C(192),1C(192) , ITEMP (7500) 
REAL A(35@@) ,B(192) ,X(192) ,RTEMP (72060) 
DATA MAX/700@6/,N/192/ 

CALL GENPRB TO SET UP PROBLEM 
CALL GENPRB(N,IA,JA,A, ITEMP, B) 

CALL PREORD TO ORDER ROWS OF A BY INCREASING NUMBERS OF NONZEROES 
CALL PREORD(N,IA,R,C,IC) 

CALL NSPIV TO SOLVE SYSTEM 


CALL NSPIV(N, IA, JA,A,B,MAX,R,C, IC, X, ITEMP,RTEMP, IERR) 
WRITE (6,161) IERR 


161 FORMAT (8H IERR = ,11@) 


aAaaAAND 


CALL RESCHK TO COMPUTE MAX-NORM AND 2-NORM OF RESIDUAL 
CALL RESCHK(N,IA,JA,A,B,X) 
STOP 
END 
SUBROUTINE GENPRB(N, IA, JA,A, B, RHS) 
GENPRB SETS UP THE MATRIX AND RIGHT HAND SIDE FROM 
THE DATA ON CARDS. THE PROBLEM IS ONE FROM THE USGS. 
INTEGER IA(1),JA(1) 
REAL B(1),A(1),RHS(1) 
KMIN = 1 
DO 5 I=1,N 
= KMIN + 38 
READ (5,1@1) (B(K),K=KMIN, KMAX) 
1@| FORMAT (8610.3) 


KMIN = KMAX + 1 
CONT TINUE 


LA(1) 
TAPTR = 
IPART = 
DO 15 T N 


l 
I 
i!) 
=l, 
RHSI = @. 
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~ 


_ 


dO 1@ J=1, 39 


K=1- 20+ J 

IF (K .LE. 6) GO TO 16 

IF (K .GT. N) GO TO 16 

IPARTJ = IPART + J 

IF (BC(TPARTJ) .EQ. @.) GO TO I 
ACTAPTR) = B(IPARTJ) 

JACTAPTR) = K 

RHSI = RHSI + B(LAPTR) 

[APTR = IAPTR + 1 

CONTINUE 


IA(I+1) = LAPTR 
RHS(L) = RHSI 


IPART = IPART + 39 
RETURN 
END 
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ALGORITHM 534 
STINT: STiff (differential equations) 


INTegrator [D2] 


JOEL M. TENDLER 

IBM Poughkeepsie Laboratories 
THEODORE A. BICKART 
Syracuse University 

and 

ZDENEK PICEL 


Key Words and Phrases: stiff differential equations, stiffly stable methods, composite multistep 
methods, cyclic methods, numerical integration, ordinary differential equations, initial value problems, 
multistep formulas, numerical integration program, Fortran code STINT 

CR Categories: 5.16, 5.17 

Language: Fortran 


DESCRIPTION 


; The algorithm given here is a complement to [1] where the theoretical develop- 
ment and test results are described. 
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[1] TENDLER, J.M., BicKart, T.A., AND PicEL, Z. A stiffly stable integration process using cyclic 
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ALGORITHM 

c* . : *MAIN iA 

(k---------- THIS IS A MAIN PROGRAM FOR STINT-TYPE SUBROUTINES ------- *MAIN 

C*k------------------+-- SFT HERE FOR N = 4 PROBLEM - ------------------ *MAIN 30 

cx *MAIN 40 
DOUBLE PRECISION D, EPS, ERO, ERORI, HI, HMAX, HMIN, HNEXT, MAIN 50 
1 H@, RJ, RW, S, SAVE, T, TF, TI, TOUT, MAIN 60 
2 TOUTP, TS, YDOT, YI, YMAX, YOUT, Y@ MAIN 70 

C DOUBLE PRECISION DABS, DBLE, DMAXL MAIN 8@ 
DIMENSTON Y!I(4), FRORI(4), YO(4,8,4), YDOT(4,4), SAVE(52), RJ(16),MAIN 9@ 
1 YMAX(4), RW(16), ERO(4), YOUT(4), IPIV(4) MAIN 100 
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cx 


1 


20 
30 


4@ 


WIE wn = 


COMMON /STAT/ NSTEP,NFE,NJE,NINVS 
DATA LLIN/5/,LOUT/6/ 


SET THE INPUT PARAMETERS 


NP PROBLEM IDENTIFIER 


MAIN 
MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 


NC NUMBER OF TIMES THE SAME PROBLEM IS SOLVED WITH DIFFERENT*MAIN 


VALUE OF EPS 

IP NUMBER OF TEST POTNTS AT WHICH THE SOLUTION IS SOUGHT 
(DOES NOT INCLUDE THE FINAL POINT) 

N NUMBER OF DIFFERENTIAL EQUATIONS TO BE SOLVED 

Yt THE INITIAT, VALUES UF THE DEPENDENT VARIABLE 

TT THE INITIAL VALUE OF THE INDEPENDENT VARIABLE 

TF THE FINAL VALUE OF THE INDEPENDENT VARIABLE 

HL THE INITIAL STEP-SIZE 

MF METHOD FLAG DETERMINING THE MODE OF THE JACOBIAN 
MATRIX EVALUATION 

EPS USERS SPECIFIED ERROR PER STEP 


READ (LIN, 16) NP 

READ (LIN, 14) NC 

READ (LIN, 1@) IP 

READ(LIN, 10) N 

FORMAT (12) 

READ(LIN, 20) (YI(1),I=1,N) 

READ(LIN, 20) TI, TF, HI 

DO 10¢@ K=1,NC 

READ(LIN, 10) MF 

READ(LIN, 20) EPS 

FORMAT (3022. 15) 

WRITE(LOUT, 36) NP, MF, EPS 

FORMAT (1H1,10X,13H PROBLEM NO. ,12// 
11X,16H METHOD FLAG =~ ,12// 
11X,18H ERROR PER STEP = ,D10.3// 
5X,4HTIME,15X,29HS OLUTION / ERROR,26X, 
7H H-USED, 3X, 7HNQ-USED, 3X,6H STEPS,3X,5H FNS ,3X, 
5H JACS//) 

DO 46 T=1,N 


SET THE NORMALTZING VECTOR YMAX 
YMAX (I )=DMAX1 (DABS (YT (1) ), 1.00) 


ERORI (1L)=0.D@ 
Y@(T,1,1)#YI(1) 


THE FOLLOWING PARAMETERS ARE USED FOR STATISTICAL PURPOSES 


NSTEP NUMBER OF ACCEPTED STEPS 

NFE NUMBER OF FUNCTLON EVALUATLONS 

NJE NUMBER OF JACOBIAN EVALUATIONS 

NINVS NUMBER OF CONVERGENCE FACTOR INVERSIONS 


NSTEP=@ 
NFE=@ 
NJE=@ 
NINVS=@ 


THE FIRST POINT AT WHICH THE SOLUTION IS SOUGHT IS SET BELOW. 


FOR TESTING PURPOSES THE SET OF POINTS TOUT AT WHICH THE 
SOLUTION IS SOUGHT IS DESIGNED SO THAT ITS DENSITY IS LARGE 
AT THE BEGINNING OF THE INTEGRATION INTERVAL AND THEN 


*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MALIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
*MAIN 
*MAIN 
*MAIN 
MAIN 
*MAIN 
MAIN 
MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 


GEOMETRICALLY DECREASES. TOUTP IS THE LAST INTERPOLATION POINT*MAIN 


HMAX, THE MAXIMUM STEP-SIZE, IS EQUAL TO THE DISTANCE 
BETWEEN THE NEXT AND LAST INTERPOLATION POINTS, MULTIPLIED 
BY 1@. 


TOUT=TI+(TF-TL) /2.DA**IP 
TOUTP#=TI 
HMAX= (TOUT-TOUTP) *1.D1 


T =TI 
HNEXT=HT 
HMIN#*HI*1.D-2 
MAXDER#=7 
JISTART#=@ 


*MAIN 
*MAIN 
*MAIN 
*MAIN 
MAIN 
MAIN 
MAIN 
*MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 


110 
120 
130 
140 
154 
160 
174 
180 
194 
200 
210 


220 
23h 
240 
250 
260 
270 
280 
290 
300 
310 
320 
330 
340 
350 
36¢ 
370 
380 
390 
400 
410 
420 
430 
44h 
450 
460 
470 
480 
490 
BYUU) 
510 
520 
530 
540 
550 
560% 
570 
580 
59¢ 
600 
610 
620 
630 
649 
650 
660 
670 
680 
690 
700 
71@ 
720 
730 
740 
750 
760 
776 
780 
790 
800 
810 
820 
830 
840 
850 
860 
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COLLECTED ALGORITHMS (cont.) 


cx 
cx 
c* 
c* 


c* 
cx 
cx 
cx 


5@ CALL STINT (N, T, Y@, YDOT, SAVE, H@, HNEXT, HMIN, HMAX, EPS, 
YMAX, KFLAG, KNEXT, JSTART, MAXDER, RW, RJ, MF, IPIV) 


60 
200 


600 


1 


IF(KFLAG.GE.@) GO TO 266 
WRITE(LOUT,6@) KFLAG 

FORMAT (1H@/2@H COMPLETION CODE IS ,14) 
GO TO 80¢ 

KFLGP1=KFLAG+1 


CHECK WHETHER THE COMPUTED SOLUTION REACHED BEYOND THE 
INTERPOLATION POINT TOUT 


II=@ 

DO 5@@ I=1,KFLGP1 

TI=II+1 
TS=TOUT-T+H@*DBLE (FLOAT (I-1) ) 
IF(TS.LT.@.D@) GO TO 500 
IF(I-1) 506, 50, 51@ 

CONTINUE 


THE SOLUTION REACHED BEYOND TOUT. 
PERFORM INTERPOLATION AT TOUT. 


IND*KFLAG+3-LI 

IF(II.EQ.2) IND=1 

Ss. (TS-H@) /H@ 

DO 6¢@ I=1,N 

D=1.D0 

YOUT(1)=Y@(1,1, IND) 

DO 6¢¢ J=1,JSTART 

D=D* (DBLE (FLOAT (J-1) )+S) /DBLE (FLOAT (J) ) 
YOUT(I)=YOUT(1)+D*Y@(1I,J+1, IND) 

CALL ERROR (TOUT ,YOUT,N,ERO) 


DETERMINE THE MAXIMUM ERROR CF THE INTERPOLATED SOLUTION 


COMMITTED SO FAR AND PRINT TT OUT WITH THE SOLUTION AT TOUT 


DO 610 I=1,N 


61@ ERORI (I)=DMAX1(ERORI (1) ,DABS(ERO(L))) 


620 FORMAT( 4H T =,D11.4,4D15.6,D12. 3, 3X, 14, 6X,14, 4X, 14,4X,14/15x, 


1 


1 


WRITE(LOUT,62@) TOUT, (YOUT(I),I=1,N), H@, JSTART, NSTEP, NFE, 


NJE, (ERO(1),I=1,N) 
4D15.6/) 


SET THE NEW INTERPOLATION POINT AND CHECK WHETHER AN 
INTERPOLATION CAN BE PERFORMED. SET NEW HMAX 


TOUTP=TOUT 
TOUT=TI+(TOUT-T1)*2.D0 
IF(TOUT.GT.TF) GO TO 8@¢@ 
IF(TOUT.LE.T) GO TO 200 
HMAX=(TOUT-TOUTP)*1.D1 
GO TO 5¢ 


REGARDLESS OF WHETHER OR NOT THE PROBLEM HAS BEEN SOLVED, 


PRINT OUT THE FINAL STATISTICS 


80% WRITE(LOUT, 810) 


81¢ 


FORMAT (1H@/20X, 2@HINTERPOLATION ERRORS) 
WRITE(LOUT, 820) (ERORI(1),I=1,N) 


820 FORMAT(1H@/10X,23H MAXIMUM ABSOLUTE ERROR//11X,4D22.8) 


DO 836 I=1,N 


830 ERORI(1I)=ERORI (1) /YMAX(L) 


WRITE(LOUT,84@) (ERORI(I),I=1,N) 


84 FORMAT(1H®@/1@X,23H MAXIMUM RELATIVE ERROR//11X,4D22.8) 


WRITE(LOUT, 854) NSTEP, NFE, NJE, NINVS 


85@ FORMAT(1H@/22H PROBLEM COMPLETED IN ,15,6H STEPS/ 


1 
2 


3 


22X,15,21H FUNCTION EVALUATIONS/ 
22X,15,21H JACOBIAN EVALUATIONS/ 
22X,15,18H LU DECOMPOSITIONS) 


100@ CONTINUE 


STOP 
END 


870 
880 
890 
960 
919 
920 
930 
940 
95 
960 
970 


MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
*MAIN 
*MAIN 
*MAIN 
*MAIN 
MAIN 980 
MAIN 990 
MAINIOOO® 
MAINI@10 
MAIN102@ 
MAIN1(30 
MAINI1040 
*MAINI@5@ 
*MAIN1(060 
*MAIN1070 
*MAIN1080 
MAIN1090 
MAIN1140@ 
MAINI1114 
MAIN1120 
MAIN1130 
MAIN1140 
MAIN115@ 
MAIN1160@ 
MAIN117@ 
MAIN1180@ 
*MAIN1190 
*MAIN1200@ 
*MAIN1210@ 
*MAIN122@ 
MAIN123@ 
MAIN124¢@ 
MAIN125@ 
MAIN1 260 
MAIN1274 
MAIN128@ 
*MAIN1290@ 
*MAIN130¢ 
*MAIN1310@ 
*MAIN1 320 
MAIN133@ 
MAIN134@ 
MAIN1350@ 
MAIN136@ 
MAIN1370@ 
MAIN1380@ 
*MAIN139@ 
*MAIN1400 
*MAIN1410 
*MAIN142@ 
MAIN143@ 
MAIN144@ 
MAIN145@ 
MAIN146@ 
MAIN1470 
MAIN148@ 
MAIN149@ 
MAIN150@ 
MAIN151¢ 


MAIN1534@ 
MAIN1540@ 
MAIN155@ 
MAIN1560@ 
MAIN157@ 
MAIN158¢@ 
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SUBROUTINE STINT (N, T, Y, DY, SAVE, H, HNEXT, HMIN, HMAX, EPS,  STNT 


+ YMAX, KFLAG, KNEXT, JSTART, MAXORD, RW, RJ, MF, STNT 

+ IPIV) STNT 
C STNT 
CRERREKRERERREREEKRERERERRRRRERERRRERRRRERRRRRRRRRERRRRRERRRRRRERRRERERERESTNT 
c* *STNT 
cx THIS PROGRAM INTEGRATES A SET OF N FIRST ORDER ORDINARY *STNT 
C* DIFFERENTIAL EQUATIONS. A BLOCK OF THREE OR FOUR SOLUTION POINTS,*STNT 
C* EACH SEPARATED BY A STEP-SIZE H, IS COMPUTED AT EACH CALL. THE *STNT 
C* STEP-SIZE MAGNITUDE MAY BE SPECIFIED BY THE USER AT EACH CALL. *STNT 
C* ALTERNATIVELY, IT MAY BE INCREASED OR DECREASED BY STINT WITHIN ¥*STNT 
C* THE RANGE DABS(HMIN) TO DABS(HMAX), *STNT 
c* IN ORDER TO ACHIEVE AS LARGE A STEP AS POSSIBLE, WHILE NOT *STNT 
C* COMMITING A SINGLE STEP ERROR WHICH IS LARGER THAN EPS IN THE *STNT 
C* RMS NORM, WHERE EACH COMPONENT OF THE ERROR VECTOR IS DIVIDED BY *STNT 
C* THE CORRESPONDING COMPONENT OF YMAX. *STNT 
c* *STNT 
c* THE PROGRAM REQUIRES 4 SUBROUTINES NAMED *STNT 
c* *STNT 
c* DIFFUN(N, T, Y, DY) *STNT 
cx PEDERV(N, T, Y, RJ, NO) *STNT 
cx DEC(N, N@, A, IPIV, IER) *STNT 
c* SOL(N, NO, A, B, IPIV) *STNT 
cx *STNT 
c* DIFFUN EVALUATES THE DERIVATIVES OF THE DEPENDENT VARIABLE Y(I) *STNT 
C* FOR I=1,...,N AND T AND STORES THE RESULT IN THE ARRAY DY. *STNT 
cx *STNT 
cx PEDERV COMPUTES THE PARTIAL DERIVATIVES OF THE DIFFERENTIAL *STNT 
C* EQUATIONS AT THE VALUES Y(I) FOR I=1,...,N AND T AND STORES THE *STNT 
C* RESULT IN ARRAY RJ. THUS, RJ(J+(K-1)*N@) IS THE PARTIAL OF DY(J) *SINT 
Cx WITH RESPECT TO Y(K) FOR J,K=1,...,N EVALUATED AT Y(I) FOR I=1,.. *STNT 
c* ..,N AND T. NOTE--N@ IS THE VALUE OF N ON THE FIRST CALL. IF THE*STNT 
c* ANALYTIC EXPRESSIONS FOR THE PARTIAL DERIVATIVES ARE NOT *STNT 
Cx AVAILABLE, THEIR APPROXIMATE VALUES CAN BE OBTAINED BY NUMERICAL *STNT 
C*  DIFFERENCING. (SEE PARAMETER MF.) IN THIS CASE SUBROUTINE PEDERV*STNT 
C* MAY SIMPLY BE *STNT 
cx *STNT 
c* SUBROUTINE PEDERV(N, T, Y, RJ, NO) *STNT 
cx RETURN *STNT 
cx END *STNT 
cx *STNT 
cx DEC PERFORMS AN LU DECOMPOSITION OF A MATRIX A. IF THE *STNT 
C* DECOMPOSITION IS SUCCESSFUL IER SHOULD BE SET TO 6, OTHERWISE IT *STNT 
C* SHOULD BE SET TO +1. *STNT 
ce *SINT 
cx SOL SOLVES THE LINEAR ALGEBRAIC SYSTEM A*X=B, FOR WHICH THE *STNT 
C* MATRIX A WAS PROCESSED BY DEC. *STNT 
cx *STNT 
cx THIS PROGRAM USES DOUBLE PRECISION FOR ALL FLOATING POINT *STNT 
C* VARIABLES, EXCEPT FOR THOSE STARTING WITH P, WHICH ARE IN SINGLE *STNT 
C* PRECISION. *STNT 
ck *STNT 
cx TEMPORARY STORAGE SPACE IS PROVIDED (BY THE USER) IN THE *STNT 
c* ARRAYS IPIV, RJ, RW, AND SAVE. THE ARRAY IPIV HOLDS A VECTOR OF *STNT 
C* THE SAME NAME. THE ARRAYS RJ AND RW ARE USED TO HOLD MATRICES OF *STNT 
C* THE SAME NAMES. THE ARRAY SAVE IS PARTITIONED AS FOLLOWS *STNT 
cx *STNT 
cx SAVE(J, 1) 1.LE.J.LE.8 AND 1.LE.I.LE.N IS USED TO SAVE *STNT 
c* Y(I,J) IN CASE A STEP (AND HENCE THE WHOLE CYCLE) ¥*STNT 
cx HAS TO BE REPEATED. *STNT 
cx SAVE(9, 1) 1.LE.I.LE.N IS USED TO STORE THE DERIVATIVE OF THE *STNT 
cx I-TH DEPENDENT VARIABLE SCALED BY H. *STNT 
cx SAVE(N9+1I,1) IS USED TO STORE THE DERIVATIVES AS THEY ARE *STNT 
cx COMPUTED BY DIFFUN FOR THE CORRECTOR. IT IS ALSO *STNT 
cx ACCESSED AS A COMPLETE ARRAY SAVE(N9P1,1). *STNT 
cx IN ADDITION IT IS USED IN THE ERRCR CONTROL TEST. *STNT 
c* (N9 = NO * 9 AND NOP1 = NO + 1.) *STNT 
c* SAVE(N1@+I,1) IS USED TO HOLD THE CORRECTION TERMS FOR THE ENTIRE*STNT 
cx CORRECTOR ITERATION IN THE CASE, THE CORRECTOR HAS *STNT 
cx TO BE REPEATED. (N1@ = N@ * 10.) *STNT 
cx SAVE(N11+1I,1) IS USED TO HOLD THE DERIVATIVES EVALUATED AT *STNT 
cx Y(I)+D AND T, WHERE D IS THE INCREMENT USED IN THE *STNT 
cx NUMERICAL DIFFERENCING SCHEME INVCKED, IN ORDER TO *STNT 
c* OBTAIN APPROXIMATE VALUES OF THE FARTIAL *STNT 
cx DERIVATIVES. (N11 = NO * 11.) *STNT 
cx SAVE(N12+I,1) IS USED TO HOLD THE DERIVATIVES EVALUATED AT Y(I) ¥*STNT 
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COLLECTED ALGORITHMS (cont.) 


AND T IN ORDER TO OBTAIN APPROXIMATE VALUES OF THE *STNT 779 


THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING MEANING 


N 


DY 


HMIN 


HMAX 


EPS 


PARTIAL DERIVATIVES. 


THE NUMBER OF FIRST ORDER DIFFERENTIAL EQUATIONS TO BE 
N MAY BE DECREASED ON SUBSEQUENT CALLS IF 


INTEGRATED. 


THE NUMBER OF ACTIVE EQUATIONS DECREASES, 
BUT, IT MUST 


FIRST ONES BEING THOSE RETAINED. 


(N12 = NO * 12. 


) 


WITH THE 


NOT BE INCREASED WITHOUT CALLING WITH JSTART = @. 


THE INDEPENDENT VARIABLE. 
SETTING OF THE INDEPENDENT VARIABLE, 


ON ENTRY T IS THE CURRENT 
ON RETURN TO THE 
CALLING PROGRAM, T CORRESPONDS TO THE SETTING OF THE 


*STNT 780 
*STNT 790 
xSTNT 80¢ 
*STNT 81¢ 
*STNT 820 
*STNT 830 
KSTNT 846 
*STNT 85¢ 
*STNT 86¢ 
*STNT 870 
*STNT 88¢ 
*STNT 8990 


INDEPENDENT VARIABLE FOR THE MOST FORWARD POINT OBTAINED*STNT 90@ 


THUS FAR. 


AN N BY 8 BY 4 ARRAY CONTAINING THE DEPENDENT VARIABLES 
ON EACH CALL UP TO FOUR*STINT 93@ 


AND THEIR BACKWARD DIFFERENCES. 


*STNT 910 
*STNT 926 


SOLUTION POINTS ARE OBTAINED. THE MOST FORWARD POINT IS *STNT 946 


ALWAYS AT Y(I,1,1). THE POINT NEXT TO THE MOST FORWARD 
POINT IS RETURNED IN Y(I,1,KFLAG). THE MOST BACKWARD 


*STNT 95@ 
*STNT 960 


POINT IN THE NEW BLOCK IS RETURNED IN Y(I,1,2). ONLY THE*STNT 970 
INITIAL SOLUTION VALUES, ENTERED IN Y(I,1,1) FOR 
I=1,...,N, NEED TO BE SUPPLIED ON THE FIRST 


CALL (JSTART = @). 


Y¥(I,J+1,K) CONTAINS THE J-TH BACKWARD DIFFERENCE OF THE 


I-TH DEPENDENT VARIABLE (FOR K=1,...,KFLAG). 


IF IT IS DESIRED TO INTERPOLATE TO NON-MESH POINTS, 
IF THE CURRENT STEP-SIZE IS 


H AND THE VALUE AT T-+E (@.LT.DABS (E) «LT. DABS (11), Junge 


THESE VALUES CAN BE USED. 


NEEDED, FORM S=E/H AND THEN COMPUTE 
NQ 
Y(I)(T-E) = SUM Y(I,J+1,K)*B(J) 
J=9 


*STNT 980 
*STINT 990 
*STNT1O00 
*STNT1G¢1¢ 
*STNT1O26 
*STNT103@ 
*STNT1G4G 
*STNT1O65@ 
*STNT1G6@ 
*STNT107@ 
*STNT108@ 
*STNT169@ 


WHERE K, WHICH CORRESPONDS TO T, IS THE FIRST MESH POINT*STNT11060 


BEYOND THE POINT T-E, AND B(J+1) = B(J)*(J-S)/(J+1) 


WITH B(@) = 1. 
AN N BY 4 ARRAY. 


SCALED BY H. 
THE FIRST CALL (JSTART = @). 


DY(I,K), 1.LE.I.LE.N, 1.LE.K.LE.KFLAG, 
CONTAINS THE DERIVATIVE OF THE I-TH DEPENDENT VARIABLE 
THE DY(I,1) ARRAY NEED NOT BE SUPPLIED AT 


*STNT111@ 
ASTNT1120 
*STNT1136 
*STNT1146 
*STNT115¢@ 
*STNT1160 


A BLOCK OF AT LEAST 13*N@ DOUBLE PRECISION FLOATING POINT*STNT1176 


LOCATIONS. 
THE. STEP-SIZE USED FOR THE JUST COMPLETED 
THE STEP-SIZE FOR THE NEXT BLOCK. ON THE 


FIRST CALL (JSTART=4) THE USER MUST SPECIFY AN INITIAL 
A GOOD ESTIMATE OF ITS MAGNITUDE IS GIVEN 


STEP-SIZE. 


BLOCK. 


BY @6.2*(EPS/DABS(E))**@.5, WHERE E IS THE LARGEST 


EIGENVALUE OF THE JAGOBIAN EVALUATED AT THE INITIAL 
THE SIGN OF THE INITIAL HNEXT 


VALUES OF T AND Y. 


SHOULD BE POSITIVE (NEGATIVE) IF THE FINAL TIME IS 


GREATER (LESS) THAN THE INITIAL TIME. 


THAN EPS IS ACHIEVED. 


CALL. 
WILL BE IGNORED. 


IF THE INITIAL 
STEP-SIZE CHOICE DOES NOT CAUSE AN ERROR GREATER THAN 
EPS, IN THE RMS NORM, IT WILL BE ACCEPTED. OTHERWISE, 
ITS MAGNITUDE WILL BE DECREASED UNTIL AN ERROR LESS 

THE SUBROUTINE AUTOMATICALLY 
ADJUSTS THE STEP-SIZE AFTER. THE INITIAL AND SUBSEQUENT 
CALLS FOR THE STEP-SIZE OF LARGEST POSSIBLE MAGNITUDE. 
THE MAGNITUDE MAY BE ADJUSTED DOWN ON ANY SUBSEQUENT 
NOTE--A MAGNITUDE ADJUSTMENT UP OR A SIGN CHANGE 


DABS (HMIN) IS THE MINIMUM STEP-SIZE MAGNITUDE TO BE 


ALLOWED FOR THE NEXT INTEGRATION CYCLE. 


(ON THE FIRST 
CALL (JSTART=@), DABS(HMIN) SHOULD BE CHOSEN SIGNIF- 


*STNT1186 
*STNT1L19@ 
*STNT120¢ 
*STNT12106 
*STNT1220 
*STNT123@ 
*STNT1240@ 
*STNT1256 
*STNT1266 
*STNT1270 
*STNT128¢ 
*STNT129@ 
*STNT1300 
*STNT131¢ 
*STNT132@ 
*STNT133@ 
*STNT134@ 
*STNTL35@ 
*STNT136¢@ 
*STNT137@ 
*STNT1380@ 
*STNT139@ 


ICANTLY SMALLER THAN DABS(HNEXT) SO AS TO AVOID START-UP*SINT1406 
PROBLEMS IF THE ERROR CRITERION IS NOT MET WITH THE USER*STNT1416 


SPECIFIED HNEXT.) 
HMIN MAY BE CHANGED ON SUBSEQUENT CALLS. 


NOTE--THE SIGN OF HMIN IS IGNORED. 


DABS (HMAX) IS THE MAXIMUM STEP-SIZE MAGNITUDE TO BE 


ALLOWED FOR THE NEXT ‘INTEGRATION CYCLE. 


DABS (HMAX) IS LESS THAN DABS(HMIN), THEN THE SUBROUTINE 
FUNCTIONS AS THOUGH DABS(HMAX) EQUALS DABS (HMIN). HMAX 


MAY BE CHANGED ON SUBSEQUENT CALLS. 
THE ERROR TEST CONSTANT. 


EPS. 
ESTIMATE IS 1/YMAX(I). 


NOTE--IF 


THE SINGLE STEP ERROR ESTIMATE 
FOR Y, COMPUTED AS A WEIGHTED RMS NORM, MUST NOT EXCEED 
THE WEIGHT FOR THE I-TH ELEMENT IN THE ERROR 
(SEE PARAMETER YMAX.) 
STEP-SIZE AND/OR ORDER ARE ADJUSTED TO ACHIEVE THIS. 


THE 


*STNT142@ 
* 

ASTNTLALO 
*STNT1454 
*STNT1460 
*STNT14706 
*STNT1480 
*STNT1490 
*STNT150¢@ 
*STNT1510 
*STNT1L520 
*STNT15 30 
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cx YMAX AN ARRAY OF N@ LOCATIONS, WITH--FOR I=1,...,N--YMAX(I) ¥*STNT154@ 
cx BEING THE MAXIMUM OF UNITY AND THE MAXIMUM VALUE OF *STNT155@ 
Ck DABS(Y(L)) SEEN THUS FAR. ON THE FIRST CALL IT SHOULD *STNT15606 
c* BE SET TO THE MAXIMUM OF UNITY AND THE INITIAL VALUE OF *STNT157¢ 
cx DABS(Y(I)). *STNT1L58@ 
Cx KFLAG A COMPLETION CODE. IF KFLAG IS GREATER THAN ¢,THEN *STNT159@ 
cx KFLAG POINTS HAVE BEEN COMPUTED. IF KFLAG IS *STNT1600 
cx -2, -3, OR -4 THEN 2, 3, OR 4 MESH POINTS, RESPECTIVELY ,*STNT161@ 
cx HAVE BEEN COMPUTED WITH DABS(H) EQUAL TO DABS(HMIN), . ¥*STNT1620 
cx BUT THE REQUESTED ERROR WAS NOT ACHIEVED. OTHER VALUES *STNT1630 
cx KFLAG CAN ASSUME ARE AS FOLLOWS *STNT164@ 
cx -5 THE REQUESTED ERROR WAS SMALLER THAN CAN BE HANDLED*STNT165¢@ 
Ck FOR THIS PROBLEM. *STNT1666 
cx -6 CORRECTOR CONVERGENCE COULD NOT BE ACHIEVED FOR *STNT167@ 
c* DABS (H) .GT.DABS (HMIN) . *STNT168@ 
cx -7 THE MAXIMUM ORDER SPECIFIED WAS TOO LARGE. *STNT169@ 
cx KNEXT AFTER THE INITIAL CALL (JSTART=@), THE VALUE OF KNEXT IS *STNT1700 
cx THE NUMBER OF POINTS TO BE COMPUTED DURING THE NEXT *STNT1710 
cx CYCLE. THE VALUE IS SUPPLIED FOR INFORMATION ONLY. THE*STNT1726 
cx USER CANNOT CONTROL THE NUMBER OF POINTS BY SETTING *STNT1730 
cx KNEXT. *STNT1740 
cx JSTART AN INPUT INDICATOR WITH THE FOLLOWING MEANINGS *STNT1750 
cx -EQ.@ INITIALIZATION CALL. (JSTART MUST BE SET TO @ ¥*STNT1760 
c* ON THE FIRST CALL.) *STNT1770 
cx .-GT.@ CONTINUE FROM THE LAST STEP. *STNT1780 
cx ON RETURN JSTART IS SET TO NQ, THE MAXIMUM BACKWARD *STNT179@ 
Cx DIFFERENCE AVAILABLE IN THE Y ARRAY. (THIS ALSO CORRES-*STNT180@ 
cx PONDS TO THE ORDER OF THE METHOD USED TO COMPUTE THE *STNT1810 
cx JUST COMPLETED BLOCK OF POINTS.) *STNT1820 
cx MAXORD THE MAXIMUM ORDER (1.LE.MAXORD.LE.7) THAT MAY BE USED. ¥*STNT1830@ 
cx NOTE--IF MAXORD IS RESET BETWEEN CYCLES TO A VALUE LESS *STNT184@ 
cx THAN THE ORDER DETERMINED FOR THE NEXT CYCLE, THEN THE *STNT1850@ 
ck ORDER MAY FOR SEVERAL CYCLES EXCEED MAXORD. HOWEVER,  *STNT1860@ 
cx IT CANNOT EXCEED THE ABOVE DETERMINED VALUE AND, ONCE ¥*STNT187@ 
cx THE ORDER IS LESS THAN OR EQUAL TO MAXORD, IT CANNOT *STNT188@ 
cx THEN EXCEED MAXORD. *STNT1890 
c* RJ A BLOCK OF AT LEAST N@**2 DOUBLE PRECISION FLOATING POINT*STNT1900 
cx LOCATIONS, WHICH CONTAINS AN ESTIMATE OF THE JACOBIAN ¥*STNT1910 
c* OF THE DIFFERENTIAL EQUATION. *STNT1920 
cx RW A BLOCK OF AT LEAST N@**2 DOUBLE PRECISION FLOATING POINT*SINT1930 
cx LOCATIONS. *STNT1940 
cx IPIV A BLOCK OF AT LEAST NO INTEGERS USED TO HOLD PIVOT DATA *STNT195@ 
cx CENERATED DURING AN LU DECOMPOSITION. *STNT1966 
c* MF ’ METHOD FLAG. IT DETERMINES THE MODE BY WHICH THE PARTIAL*STNT1976 
cx DERIVATIVES ARE OBTAINED WITH THE FOLLOWING MEANINGS *STNT1980 
cx 1 ANALYTIC EXPRESSIONS FOR THE PARTIAL DERIVATIVES ARE *STNT1990 
cx SUPPLIED BY THE USER IN THE SUBROUTINE PEDERV. *STNT 2000 
c* 2 THE ANALYTIC EXPRESSIONS ARE NOT AVAILABLE. *STNT20106 
cx APPROXIMATE VALUES OF THE PARTIAL DERIVATIVES ARE *STNT 2026 
cx OBTAINED BY NUMERICAL DIFFERENCING. *STNT 2030 
ck *STNT2040 
CER KAKA KKKKRKKERKAR RAK ERK ERE RRRE RRR ERR KERR RERER ERR EE RRR RERRRERE EERE REE KS TNT 20 50 
C STNT 2060 
DOUBLE PRECISION B, BND, Bl, B2, C, CRATE, D, DF, DI, DY, STNT2070 

+ Dl, D2, D3, E, EDOWN, ENQDWN, ENQSAM, STNT2080 

+ ENQUP, EPS, ES, EUP, FN, H, HMAX, HMIN, STNT 20690 

+ HNEW, HNEXT, HOLD, Q, RATIO, RC, RJ, RMAX, STNT21060 

+ RRDOWN, RRSAME, RRUP, RW, SAVE, SQRTUR, T, STNT211@ 

+ TDL, TOLD, UROUND, Y, YJ1, YMAX STNT2120 

G DOUBLE PRECISION DABS, DBI.E, DMAX1, DMIN1, DSQRT STNT2130 
DIMENSION Y(N,8,4), DY(N,4), SAVE(9,1), YMAX(1), RW(1), IPIV(1), STNT2140 

+ INDEX(7,2), B(82), C(16), PERROR(9), PC(16), PD(7), STNT2150 

+ B1(48), B2(34), RJ(1) STNT2160@ 
COMMON /STAT/ NSTEP,NFE,NJE,NINVS STNT2170 
EQULVALENCE(B(1) ,B1(1)), (B(49) ,B2(1)) STNT2180 

C SINT2190 
Cc HREKRKKEKKEEERKRERERREEKEKEEKEREKEREKEEEEKRREREKREEKRKRKKR STNT2200 
Cc *xkkKK SEVEN OF EIGHT DATA STATEMENTS CONTAIN **#xx STNT2210 
C *kkkkK ARRAY NAMES AND VARIOUS LINES OF CODE **kx* STNT2220 
Cc xkkkK INCLUDE SUBSCRIPT EXPRESSIONS. KKK STNT2230) 
C KREKKKKKEKREKKEREREREKKAEKKEKREREREKEKRKERKKKK RRR STNT224@ 
C STNT225@ 
CHRKRRARKKAKKKKKKERRERKAEKKRKAEKREREREREREEREREERERAKRE KER ER ERERERERAERERERRES TNT 2 260 
Cx THE CONSTANT UROUND SHOULD BE SET EQUAL TO THE UNIT ROUND-OFF *STNT2270 
Cx FOR THE MACHINE. THE CONSTANT SQRTUR SHOULD BE SET EQUAL TO THE *STNT228@ 
C* SQUARE ROOT OF UROUND. *STNT2290 


CREKRKKEKRRERKEKEREREERERERERRERKRERERERERREARERERKREKKARERRKRERERERERERRERERERSTNT 2 300 
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Cc STNT2310 

DATA UROUND/4.D-16/, SQRTUR/2.D-8/ STNT232@ 

C STNT2330 

CRI II IR RII IRI RFR RR III CR IITA R IIR IR RR TAT IR TOTTI RIKI A IIIA IS AIA IASTN TD B40 

Cx THE ARRAY INDEX HOLDS POINTERS AND CONSTANTS FOR THE VARIOUS *STNT235@ 

C* ORDER METHODS. FOR NQ=1,...,7 THE ENTRIES ARE AS FOLLOWS *STNT 2360 

c* INDEX(NQ,1) BASE INDEX FOR B ARRAY (H*DY PREDICTOR). *STNT2370 

cx INDEX(NQ,2) BASE INDEX FOR CG ARRAY (CORRECTOR). *STNT238@ 

CRRRRRK IK IK KKK RRR ERKRI IRI IR IRI IKE RARER IR IK IR IKI I HK IAI IK III IAK ERIK RIK TNT 39 0 

C STNT 2400 

DATA INDEX/ 1, 2, 4, 11, 20, 38, 59, STNT2410 

+ Ly ey Sy. Sy Ty: Wy Ady STNT242@ 

C STNT2430 

CRRRRARR RI KK KR RRR RIKER RII IKK IIR RIKER ER ITI ITOK IIA IIIA IA IOI IAAI IAI TINT 2G G0 

CX THE COEFFICIENTS APPEARING IN THE NEXT DATA STATEMENTS FOR THE *STNT245@ 

C* 8 ARRAY SHOULD BE DEFINED TO THE MAXIMUM ACCURACY PERMITTED BY *STNT2460 

Cx THE MACHINE. THEY ARE, TN THE ORDER SPECIFTED,... *STNT247 

ck 1 *STNT 2480 

ck -2, 3 *STNT249@ 

cx -9/2, -5/4, 11/2 *STNT2500 

cx -15/2, -3/4, 13/2, 2 *STNT251 

ck -22/3, -8/3, -17/18, 25/3 *STNT252¢ 

cx -9, -9/4, -7/8, 35/4, 5/4 *STNT25 30 

cx -125/12, -191/24, -71/36, -37/48, 137/12 *STNT254@ 

ck -253/24, -1601/246, -707/360, -123/160, 1373/1260, 1/10 *STNT255@ 

cx -57/4, -25/8, -17/10, -169/240, 61/5, -1/20, 31/10 *STNT256@ 

cx -137/10, -117/26, -46/15, -191/126, -197/300, 147/10 *STNT2579 
Cr ~ 353/25, -571/100, -1819/600, -79/50, -3919/6006, 1477/1060, 7/26 *STNT2580 
cx - 3529/2066, -1889/406, -1609/600, -3527/2466, -931/1500, 3079/2060, *STNT2590 
iy ~3/20, 17/5 *STNT2600 
c* - 343/20, -303/40, -253/60, -589/244, -101/75, -23/40, 363/20 *STNT261@ 
ck -266/15, -221/30, -749/180, -73/30, -803/600, -103/180, 547/30, *STNT2620 
Ce 1/2 *STNT263 
cx -1316/75, -1151/15¢, -3689/900, -121/56, -4063/3000, -257/45%, ¥*STNT264 

cx 2737/15@, -1/5, 1/ *STNT2650 

CRAKKRRRKR ARR KEREK ERK RE KK RERER ERE REE ERE RRR KK RERRRKEE KERR ERE RE RER EER EKS TNT 2 660) 

Cc STNT2670 

DATA B1/ STNT2684% 

+ 1.0D0, -2.0D0, 3.0D0, -4.5D%, -1.25D0, 5.5D0#, -7.5D0, STNT2690 

+ -.75D0, 6.5D0, 2.0D0, -7.3333333333333333D0, STNT2700 

+ -2.6666666666666667D0, -.94444444444444444D6, STNT271@ 

+ 8. 3333333333333333D0, -9.0D0, -2.25D0, -.875D¢, 8.75D@, STINT2720 

+ 1.25D0, -10.416666666666667D0, -4.2683333333333333D0, STNT2730 

+ -1.9722222222222222D6, -.77083333333333333D0, STNT2740 

+ 11. 416666666666667D0, -10.541666666666667D0, STNT275@ 

+ -4,1708333333333333D0, -1.9638888888888889D%, -.76875D%, STNT2760 

+ 11.441666666666667D¢, @.1D0, -14.25D@, -3.125D@, -1.7D@, STNT277@ 

+ -.70416666666666667D0, 12.2D0, -.@5D¢, 3.1D0, -13.7Dd, STNT2780 

+ -~5.85D0, -—3.0666666666666667D0, -1.5916666666666667D¢, STNT279@ 

+ -.65666666666666667D0, 14.7D0, -14.12D¢, -5.71D¢, STNT28060 

+ -3.0316666666666667D0, -1.58D0, -.65316666666666667D0/ STNT2810 

DATA B2/ STNT282@ 

+ 14.77D0, @.35D0, -17.645D0, -4.7225D0, STNT283@ 

+ -2.6816666666666667D0, -1.4695833333333333D0, STNT2840 

+ - .62066666666666667D%, 15.395D%, -.15D0, 3.4D%, -17.15D¢0, STNT285¢ 

+ -7.575D@, -4.2166666666666667D%, -2.4541666666666667D0, STNT2860@ 

+ -1.3466666666666667D6, -.575D0, 18.15D0, STNT2870 

+ -17. 733333333333333D0, -7.3666666666666667D0, STNT2880 

+ -4,1611111111111111D0, -2.4333333333333333D0, STNT2890 

+ ~1.3383333333333333D0, -—.57222222222222222D0, STNT 2900 

+ 18. 233333333333333D¢0, @.5D0, -17.546666666666667D0, STNT2910 

+ -7.6733333333333333D0, -4.0988888888888889D¢, -2.42D0, STNT29 20 

+ -1.3343333333333333D6, —.57111111111111111D4, STNT29 36 

+ 18. 246666666666667D0, -%.2D0, 6.5DA/ STNT2946 

Cc STNT295@ 

CHERRKKAKRKEKKKERKRK ARERR ER EAKREREREREREEKIREE RRR EKER EER EREEEREKREREREKERES TNT 2960 

C* THE COEFFICIENTS APPEARING IN THE NEXT DATA STATEMENTS FOR THE *STNT2970 

Cx C ARRAY SHOULD BE DEFINED TO THE MAXIMUM ACCURACY PERMITTED BY *STNT2980 

c* THE MACHINE. THEY ARE, IN THE ORDER SPECIFIED,... *STNT299@ 

ck Ze *STNT 3000 

cx -2/3 *STNT3019 

cx -6/11, -2/3 *STNT3026 

cx -12/25, -16/31 *STNT3030 

cx -60/137, -600/1373, -1060/193 *STNT 3040 

cx -20/49, -12¢/293, -75/184, -1206/2299 *STNT3050 

cx -140/363, -60/143, -10506/2437 *STNT 3060 


CREKKRKK ERK ERKRKKERR EKER EKERERE REE REE ERKRE REE ERE RRR ERERERERERERERERERKS TNT 3976 
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Cc STNT308¢ 
DATA C/ -1.0D0, -.66666666666666667D@, -.54545454545454545D¢, STNT309@ 

+ — .66666666666666667D0, -.48D0, —.51612903225806452D0, STNT3100 

+ -—.43795620437956204D0, -.43699927166788056D0, STNT311¢ 

+ —.51813471562590674D0, -—.40816326520612245D0, STNT 3120 

+ -.40955631399317406D0, -—.46760869565217391D0, STNT313@ 

+ -.52196607220530666D0, -.38567493112947659D4, STNT314@ 

+ -.41958041958041958D0, -.430857611&1780879D0/ STNT3150 

Cc STNT3160@ 


CRAKEAR RARER ARERR IARI ER ARERR ARERR ERIE IR IAAI IRS TNT 3170 
Cx THE COEFFICIENTS IN THE PERROR ARRAY ARE USED IN THE ERROR TEST, *STNT3180 
Cx THE FIRST TIME IT IS PERFORMED, AS WELL AS IN THE STEP-SIZE/ORDER *STNT319@ 
C* SELECTION SEGMENT. PERROR(I+1) = 1/D(I+1), I=1,...,7, WHERE *STNT 3200 
C* D(I+1) IS THE DISCRETIZATION ERROR CONSTANT CORRESPONDING TO THE *STNT3214 


cx SECOND PASS OF THE INTEGRATION CYCLE OF ORDER I. PERROR(1) AND *STNT3220 
cx PERROR(9) ARE DEFINED SOLELY FOR PROGRAMMING EASE. THEY ARE NOT *STNT3230 
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cx USED. *STNT3240 
CHERKRKKKEKKERERERERKERERRRER ERK ERERERERERERERERE RE REE RERKEREREREREEREEEKESTNT 3250 
Cc STNT326@ 
DATA PERROR/ 1.0, 1.0, 1.92857, 2.78161, 3.56735, STNT 3270 

+ 4.29497, 4.9065, 5.6066, 1.¢@/ STNT3280 

C STNT 3290 


CHERKEREREKE EKER ERE ERR ERE REREREREREREERERERERERERRE KERR REREREEKERERERES TNT 3 300 


Cx THE COEFFICIENTS IN THE ARRAY PC ARE USED BOTH IN THE CONVERGENCE *STNT331@ 
Cx AND ERROR TESTS. THEY ARE THE RECLPROCAL VALUES OF THE *STNT 3320 
Cx DISCRETIZATION ERROR CONSTANTS FOR EQUATIONS CONSTITUTING THE *STNT 3330 
Cx METHODS OF ORDER 1 THRU 7. *STNT 3340 
CERRKAAKAKREKKEREKKRERERERERRKEREEERERERERERERREERKKRERRERKEKEKRERERREREREREERRS TNT 3 350 
c STNT336@ 
DATA PC/ 2.0, 4.5, 7.3333, 6.0, 10.4167, 9.3, 13.7, 13.8687, STNT337@ 

+ 9.6904, 17.15, 16.9504, 17.4349, 9.472, 20.7429, 15.921,STNT3380 

+ 14.7809/ STNT 3390 

Cc STNT 3400 


CHERKRRAKKEKRKREKREREEEREREEREREREREREREREARRERERERERERRERIERRRERERERERREREERRERS TNT 3416 


Cx THE COEFFICIENTS APPEARING IN THE ARRAY PD ARE USED IN THE TESTING*STNT3420 
Cx OF THE *OUTDATEDNESS* OF THE ARRAY RW. THE PD(I) ELEMENT CONTAINS*STNT3430 
C* THE AVERAGE VALUE OF THE COEFFICIENTS IN ARRAY C CORRESPONDING TO *STNT3440 
C* ORDER I. *STNT3450 
CHEKRKKRRKRRRIRKRRRKEERERERRERRRIRERKEREEKR RRR EERE ERERRERRERERERERERERES TNT 3460 
Cc STNT347@ 

DATA PD/ 1.0, 0.6667, 0.6061, 0.4981, 6.4644, 6.4368, @.412/ STNT 3480 
Cc STNT 3490 


CRARKKAKKEARERAKAKEARRE AERA KEKEARERERIEKRERKARRERERRERERERERERERERERERERS TNT 3 500 
CHEKKRKRERRKKAEREERRERRERERERERERERERERKERERERRREREREER KERR RERERERERERERES TNT 3510 


30 


4Q 


KFLAG = @ 
IFAIL = @ 
IF(JSTART.NE.@) GO TO 8@ 


INITIALIZATION --- FIRST CALL 


N@ = N 
FN=DBLE (FLOAT (N) ) 
N9 = Nd * 9 
NOP] = N9 + 1 
N1@ = NO + NO 
N11 = N1@ + NO 
N11P1 = N11 +1 
N12 = N11 + NO 
N12P1 = N12 + 1 
NSQ = NO*NO 
IWEVAL#+1 
TDL=T 
H=DMAX1 (DABS (HMIN) , DMIN1 (DABS (HNEXT) , DABS (HMAX) ) ) 
IF(HNEXT.LT.@.D@) H=-H 
NQOLD= @ 
ISW1=@ 
ISW2=0 
CRATE=1.D@ 
CALL DIFFUN (N, T, Y, DY) 
NFE=NFE+1 
DO 4@ I=1,N 
DY(I,1) = H*DY(I,1) 
NQ = 1 
Ist = 1 
IDEL = 0 
GO TO 18¢ 


STNT3520 
STNT3530 
STNT3540 
STNT355@ 
*STNT 3560 
*STNT 3570 
*STNT3580 
STNT359@ 
STNT 3600 
STNT3610@ 
STNT362@ 
STNT 3630 
STNT3640 
STNT365@ 
STNT 3660 
STNT 3670 
STNT 3680 
STNT369@ 
STNT 3700 
STNT371@ 
STNT372@ 
STNT3730 
STNT 3740 
STNT3750 
STNT 3760 
STNT3770 
STNT3780 
STNT379@ 
STNT 3800 
STNT381¢ 


STNT 3820 
STNT 3830 
STNT 38406 
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COLLECTED ALGORITHMS (cont.) 


Cx 
C* 
Cx 


cx 
cx 
Ck 


cx 
Cx 
ce 


Ck 
Cx 
Ck 
Ck 


c* 


80 HNEW=DMAX1 (DABS (CHMIN) , DMIN1 (DABS (HNEW) , DABS (HNEXT) , DABS (HMAX) ) ) 


100 


120 
144 
15% 


160 


180 


200 


220 


260 


280 


CONTINUE WITH THE STEP-STZE H 


LF(H.1LT.@.D0) HNEW=-HNEW 
TF(H.NE.HNEW) GO TO 100 
IST = NQP1 

TDEL = NQP1 

TSW2=0 

GO TO 180 


NEW STEP-SIZE --- INTERPOLATE FOR NEW POINTS 


RAT TO=HNEW/H 
H = RATLO*H 
RC*RC*RAT LOXDBLE (PD (NQ) / PDOLD) 
PDOLD = PD(NQ) 
IF (NQ.EQ.1) GO TO 150 
LEQ = NEQ 
D = 0.0D0 
DO 140 J=2,NQ 
D = D + RATIO 
IF (D.GT.DBLECFLOAT (NEQHNQPI-LEQ))) TEQ=2 
DI = DBLECFLOAT (NEQ-1F.Q-1)) - D 
DO 140 T=1,N 
D2 = 1.0D0 
D3 = A.OdA 
DO 120 J1=2,NQP1 
D2 = N2*(DBLE(FLOAT(J1)) + D1)/DBLE(FLOAT(J1-1) ) 
D3 = D3 + D2*Y(1,J1, 1FQ) 
Y(I,J,1) = D3 + Y(T,1,1EQ) 
TST = NQ 
IDEL = @ 
DO 16@ T=1,N 
DY(1,1) = DY(1T,1)*RATIO 
[RET = 3 
GO TO 4600 


INITIALIZE SAVE ARRAY 


DO 200 I=1,N 

SAVE(9,I) = DY(1I,1) 

DO 20@ J=1,1ST 

SAVE(J,T) = Y(I,J,1) 

NQST = NQ 
RATIO = 1. @D¢ 
TOLD = T 
HOLD = H 
LF ((NQ.EQ.NQOLD).AND. (FN. EQ.DBLE(FLOAT(N)))) GO TO 36@ 
IF ((NQ.EQ.NQOLD) AND. (FN.NE.DBLE(FLOAT(N)))) GO TO 280 
IF (MAXORD.LT.8) GO TO 260 
KFLAG = —7 
GO TO 4185 


SET APPROPRIATE PARAMETERS AND CONSTANTS 
FOR NEW CYCLE OF ORDER NQ 


INDB = INDEX(NQ, 1) 

INDC = INDEX(NQ, 2) 

NEQ = 3+#NQ/5 

JSTART = NQ 

NQOLD = NQ 

NQM1=NQ-1 

NQP] = NQ+t1 

Q = DBLE(FLOAT(NQ) ) 

ENQDWN = @.5D06/Q 

ENQSAM = @.5D@/(Q+1.6D0) 

ENQUP = @.5D@/(Q+t2.@D0) 

FN = DBLE(FLOAT(N) ) 

EDOWN = FN*(DBLE(PERROR (NQ) )*EPS) **2 
EUP = FN*(DBLE(PERROR(NQ+2) )*EPS) **2 
ES = FN*(DBLE(PERROR(NQP1) )*EPS)**2 

IF(EDOWN.GT.@.D@) GO TO 300 

KFLAG = -5 

GO TO 4185 


*STNT 3850 
*STNT 3860 
*STNT 3870 
STNT3880 
STNT 3890 
STNT 3900 
STNT3910 
STNT 3920 
STNT 39 30 
STNT 3949 
*STNT395@ 
*STNT 3960 
*STNT3970 
STNT 3980 
STNT3990 
STNT4000 
STNT4010 
STNT4020 
STNT4030 
STNT4@40 
STNT4050 
STNT4960 
STNT4Q7@ 
STNT408@ 
STNT409@ 
STNT4100 
STNT4110@ 
STNT412@ 
STNT413@ 
STNT4140 
STNT4150 
STNT4160 
STNT4170 
STNT4180 
STNT4190 
STNT4200 
STNT4210 
*STNT4220 
*STNT4230 
*STNT4240 
STNT4250 
STNT4 260 
STNT4270 
STNT4280@ 
STNT4290@ 
STNT4300 
STNT431@ 
STNT4 320 
STNT4330 
STNT4 34% 
STNT4350 
STNT4 360 
STNT4 370 
*STNT4380 
*STNT4390 
*STNTS4OO 
*STNT4410 
STNT4420 
STNT44 30 
STNT4440 
STNT4450 
STNT4460 
STNT447@ 
STNT448@ 
STNT449@ 
STNT450@ 
STNT451@ 
STNT4520 
STNT4530 
STNT454@ 
STNT455@ 
STNT456@ 
STNT4570@ 
STNT458@ 
STNT459@ 
*STNTG6OO 
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c* 
cx 


cx 
cx 
cx 


c* 
c* 
cx 
c* 
cx 


340 
360 
380 
400 


420 
40 
460 


470 
500 
510 


52@ 


540 


CHECK FOR REEVALUATION OF JACOBIAN *STNT4610 
*STNT 4620) 

306 IF(IWEVAL.GT.@) GO TO 320 STNT46 30 
IF (DABS (RC-1.D@).GE.4.D-1) IWEVAL = +2 STNT4640° 
IF((TDL-TOLD)*H.GT.@.D@) GO TO 32@ STNT4650 
IF(DABS(RC-1.D0@).GE.8.D-1) IWEVAL = +1 STNT4660@ 
320 INDBB = INDB STNT4670 
INDCC = INDC STNT4680 
DO 1600 TEQ=1,NEQ STNT4690 
IST = MOD (IEQ, NEQ) + 1 STNT4700 
T=eT+t+H STNT471¢ 
BND=FN* (DBLE (PC (INDCC) ) *ENQUP*EPS) ®*2 STNT4720 
EES STNT4 730 
IF(IEQ.GT.2) E=FN*(DBLE(PC(INDCC) ) *EPS)**2 STNT474@ 
*STNT475@ 

PREDICT Y AND DY FOR THE |NEXT MESH POINT *STNT4 760 
*STNT4770 

DO 46¢@ I=1,N STNT4780 
D = DY(I,1EQ) STNT4790 
D1 = Y(1,1,1EQ) + Q*D STNT4800 
D2 = B(INDBB+NQM1)*D STNT481¢ 
IF (NQ-2) 446, 400, 344 STNT4820 
IF (1EQ-3) 400, 380, 360 STNT4830 
D2 = D2 + BC(INDBB+NQP1)*DY (I, 3) STNT484@ 
D2 = D2 + BCINDBB+NQ)*DY (T, 2) STNT485@ 
DO 420 J=2,NQ STNT4 860 

D = Y(1I,J,IEQ) STNT487@ 

D3 = DBLE(FLOAT(J-1) ) STNT488¢ 

D1 = D1 + D*(D3-Q)/D3 STNT4890 

D2 = D2 + N*BCINDBB+J-2) STNT4900 
Y(I,1,1IST) = D1 STNT4910 
DY(I,IST) = D2 STNT4920 
IF(NQ.LE.2) GO TO 474 STNT49 30 
IF(LEQ.GT.1) INDBB = INDBB + wQ + TEQ - 2 STNT4940 
*STNT4950 

ITERATE THE CORRECTOR UP TO THREE TIMES. ACCUMULATE THE *STNT4960 
CORRECTION TERMS TN SAVE(NI@+I,1) FOR REDOING THE ENTIRE *STNT4970 
CORRECTOR IF CONVERGENCE 1S NOT ACHLEVED *STNT49 80 
*STNT4990 

D1 = C(INDCC) STNT50OO 
DO 51@ I=1,N STNT5@1O 
SAVE(NI@+1,1) = @.D@ STNT5020 
DO 78@ J=1,3 STNT5030 
CALL DIFFUN (N, T, Y(1,1,1ST), SAVE(N9P1,1)) STNT5040 
NFE=NFE+1 STNT5050 
IF(IWEVAL-1) 680, 520, 620 STNT5060 
IND = 1 STNT5O7@ 
IF(LEQ.EQ.2) IND = 1 STNT5080 
GO TO (61@, 530), MF STNTSO9A 
CALL DIFFUN (N, T-H*DBLE(FLOAT(1+IEQ-IND)), Y(1,1, IND), STNT5 1060 
SAVE(N12P1, 1)) STNT5S1I1@ 
NFE=NFE+1 STNT5120 

D = @.DA STNT5130 
DO 54@ I=1,N STNT5140 

D = D + SAVE(N12+1, 1) **2 STNT5150 

D = DABS(H)*1.D3*UROUND*DSQRT (D) STNT5 160 
NJE = NJE + 1 STNT5170@ 
Jd = 6 STNT518@ 
DO 56@ Jl=1,N STNT5190 
DI = SQRTUR*YMAX(J1) STNT5 200 

DL = DMAX1(DI,D) STNT5219% 

YJ1 = Y(J1,1, IND) STNT5220 
Y¥(J1,1,IND) = Y(J1,1,IND) + DI STNT5230 
CALL DIFFUN (N, T-H*DBLE(FLOAT(1+IEQ-IND)), Y(1,1,IND), STNT524@ 
SAVE(N11P1, 1) ) STNT5 250 

NFE = NFE + ] STNT5 260 

DO 55@ I=1,N STNT5270 
RJ(I+J@) = (SAVE(N1I1+1,1) - SAVE(N12+1,1))/DI STNT5 280 

JO = Jf + NO STNT5290 
Y(J1,1,IND) = YJ1l STNT5 300 
CONTINUE STNT531@ 

GO TO 620 STNT532¢ 
CALL PEDERV(N, T-H*DBLE(FLOAT(1+TEQ-IND)), Y(1,1, IND), RJ, N@)STNTS 330 
NJE=NJE+1 STNT5340 

D = D1*H STNT5 35@ 
DO 640 I=1,NSQ STNT5 360 
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640 


666 


680 
700 


760 


770 
780 


800 


960 


920 


940 


960 


980 


RW(L) = RJ(1I)*D 
Jl = 1 
DO 664 I=1,N 

RW(J1) = 1.D@ + RW(J1) 

Jl = Jl + NO +1 
CALL DEC (N, N@, RW, TPIV, IER) 
NINVS=NINVS+1 
IWEVAL = -LEQ 
RC=1.DA 
PDOLD=PD (NQ) 

IF(LER.NE.@) GO TO 84¢ 
DO 766 T=1,N 

SAVE(N9+1,1) = DY(1,IST) - H*SAVE(N9+T, 1) 
CALL SOL (N, N@, RW, SAVE(N9P1,1), TPIV) 

D2 = @.ODO 
J3 = NY 
DO 76% I=1,N 

J3 = J3+ 1 

J2 = J3 + NO 

SAVE(J2,1) = SAVE(J2,1) + SAVE(J3,1) 

Y(1,],1ST) = Y(I,1,IST) + DI*SAVE(J3,1) 

DY(I,IST) = DY(1,IST) - SAVE(J3, 1) 

D2 = D2 + (SAVE(J3,1)/YMAX(I))**2 
IF(J.NE.1) CRATE = DMAX1 (CRATE*9.D-1,D2/D3) 
IF (D2*DMIN1(1.D0, 2. DO*CRATE) .GT.BND) GO TO 770 
GO TO 944 
D3 = D2 
CONTINUE 


CORRECTOR FAILED TO CONVERGE IN THREE ITERATIONS. 


IF JACOBIAN WAS REEVALUATED DURING THIS CYCLE, STEP-SIZE IS 


REDUCED TO 3/10 OF H. OTHERWISE, JACOBIAN IS REEVALUATED 


TDL = TOLD 
IF(IWEVAL.EQ.@) GO TO 90¢ 


LF (DABS(H) .LE. (1.00@01D@*DABS(HMIN))) IF(NQ-2) 4184, 1080, 4140 


RATIO = RATIO*@. 3D% 

IRET = 1 

ISW1=@ 

ISW2=1 

IWEVAL = +2 

GO TO 3000 

DO 92@ I=1,N 
D = SAVE(NI1@+1,1) 
Y(1,1,IST) = Y(I,1,IST) - D1*D 
DY(I,1ST) = DY(I,IST) + D 

IWEVAL = +1 

GO TO 5¢¢ 


CORRECTOR CONVERGED. THE BACKWARD DIFFERENCES OF ORDER 
ONE THROUGH NQ AT THE NEW MESH POINT ARE COMPUTED 


DO 98¢@ I=1,N 
DO 964 J=1,NQ 
Y(1I,J+1,IST) = Y(1,J,IST) - Y(I,J,1IEQ) 
IF(IEQ.EQ.1) GO TO 98 


THE (NQ+1)-ST BACKWARD DIFFERENCE FOR ALL BUT THE FIRST 
MESH POINT IS ESTABLISHED 


SAVE(N9+I,1) = Y(I,NQP1,IST) - Y(I,NQP1, IEQ) 
CONTINUE 

IF (1EQ.EQ.NEQ) GO TO 1015 

IF (NQ.LE.2) GO TO 10614 

IF ((1EQ.GT.1).OR.(NQ.EQ.6)) INDCC = INDCC + 1 
IF(IEQ.EQ.1) GO TO 10600 


ERROR TEST FOR ALL BUT THE FIRST MESH POINT IS PERFORMED 


D = @.D¢ 
DO 102@ I=1,N 
D = D + (SAVE(N9+1,1)/YMAX (1) )**2 
IF(D.GT.E) GO TO 1630 
CONTINUE 


GO TO 116¢ 


STNT5370@ 
STNT5 380 
STNT5390 
STNT5400 
STNT54104 
STNT5420 
STNT5430@ 
STNT5440 
STNT545@ 
STNT5460% 
STNT5470@ 
STNT548@ 
STNT5490 
STNT5 500 
STNT551@ 
STNT5520 
STNT5530 
STNT5540 
STNT555@ 
STNT556@ 
STNT5579 
STNT5580 
STNT559@ 
STNT 5600 
STNT5S610 
STNT56206 
STNT5630@ 
STNT5640 
*STNT5650@ 
*STNT5 660 
*STNT5670 
*STNT5 680 
*STNT569@ 
STNT5 700 
STNT5710 
STNT572@ 
STNT573@ 
STNT574@ 
STNT575@ 
STNT576@ 
STNTS77@ 
STNT578@ 
STNT579@ 
STNT5 800 
STNT5810 
STNT582@ 
STNT5 830 
STNT5 840 
*STNT5850 
*STNT5860 
*STNT5870 
*STNT5880 
STNT589¢@ 
STNT590O 
STNT5914 
STNT5924 
*STNT59 30 
*STNT5940 
*STNT5950 
*STNT596@ 
STNT597@ 
STNT598@ 
STNT5990 
STNT6000 
STNT601¢ 
STNT602¢ 
*STNT6030 
*STNT6040 
*STNT6050 
STNT60660 
STNT6070 
STNT6080 
STNT6090 
STNT61060 
STNT6110 
*STNT6120 
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cx THE ERROR CRITERION WAS NOT MET 
cx 
1030 IFAIL=IFAIL+1 
IF(IFAIL.GT.2) GO TO 1080 
IF (DABS (H) .LE. (DABS (HMIN)*1.60001D@)) IF(NQ-2) 1140, 4126, 4140 
IWEVAL = +2 
IF(IFAIL.EQ.1) GO TO 120¢@ 
TDL=T 
RATIO = RATIO*5.D-1 
IRET = 1 
1SW1=0 
ISW2=] 
GO TO 30¢¢ 
Ck 
cx START OVER WITH ORDER 1 METHOD 
cx 
1680 IFAIL = 0 
DO 1090 I=1,N 
109@ Y(1,1,1) = SAVE(1,1) 


T = TOLD 
H = H*DMAX] (1.D-1, DABS (HMIN/H) ) 
IWEVAL = +2 
GO TO 3¢ 
Ck 
cx A NEW BLOCK OF SOLUTION POINTS HAS BEEN ACCEPTED 
cx 


1140 IWEVAL = @ 
NSTEP = NSTEP + IEQ 
KFLAG = -LEQ 
RETURN 
116% IWEVAL = @ 
E = ES 
KFLAG = NEQ 
NSTEP = NSTEP + KFLAG 


HNEW=H 
cx 
cx CHECK FOR CONTINUATION WITH THE SAME H AND NQ 
ck 
IF(1SW2.EQ.1) GO TO 142@ 
IF(NQ.GT.3) ISW1=1-ISW1 
IF(ISW1.EQ.1) GO TO 142¢ 
Ck 
cx NEW STEP-SIZE AND/OR ORDER SELECTION 
cx 


120@ RRSAME=1. 2D0* (D/E) **ENQSAM 
IF(IFAIL.NE.@) GO TO 138¢ 
RMAX = 1.D-4 
DF=DBLE (FLOAT (NEQ4NQM1) ) 
IF(NQ.NE.1) RMAX=(Q-1.D0) /DF 
RRSAME=DMAX1 (RRSAME , RMAX) 
RRUP = 1.D2@ 
RRNOWN = 1.D2@ 
IF(NQ.GE.MAXORD) GO TO 124@ 
D = @.0D0 
DO 122 I#1,N 
D1 = Y(I,NQP1,NEQ) - Y(1,NQP1,NEQ-1) 
1226 D= D+ ((SAVE(N9+1,1) - D1)/YMAX(1))**2 
RRUP = 1. 2D06* (D/EUP)**ENQUP 
RMAX=Q/DF 
RRUP=DMAX 1 (RRUP , RMAX) 
124@ IF(NQ.EQ.1) GO TO 128@ 
D = $.0D0 
nO 1260 I=1,N 
1260 D=D + (Y(I,NQP1,1)/YMAX(1))**2 
RRDOWN = 1. 2D0* (D/EDOWN) **ENQDWN 
RMAX = 1.D-4 
LF(NQ.NE.2) RMAX=(Q-2.DQ) /DF 
RRDOWN=DMAX 1 (RRDOWN , RMAX) 
1280 IF (RRSAME.GT.RRUP) IF (RRUP-RRDOWN) 134@, 13060, 1300 
IF (RRSAME.LE.RRDOWN) GO TO 132¢ 
1300 NEWQ = NQM1 
D=1.D@/RRDOWN 
GO TO 136¢ 
132@ NEWQ = NQ 
D=1.D@/RRSAME 
GO TO 136¢ 


*STNT61 30 
*STNT6140 
STNT6150 
STNT6160 
STNT6170 
STNT6180 
STNT6190@ 
STNT6 200 
STNT621@ 
STNT6220 
STNT6230 
STNT6 240 
STNT6250 
*STNT6 260 
*STNT6270 
*STNT6 280 
STNT6290 
STNT6 300 
STNT6 310 
STNT6 3206 
STNT6 330 
STNT6 340 
STNT6 350 
*STNT6 360 
*STNT6 370 
*STNT6 380 
STNT6 390 
STNT6400 
STNT6410 
STNT6420 
STNT6430 
STNT64406 
STNT645@ 
STNT6460 
STNT647@ 
*STNT6480 
*STNT6490 
*STNT6500 
STNT6510 
STNT6520 
STNT653@ 
*STNT654@ 
*STNT655@ 
*STNT6560 
STNT657@ 
STNT6 580 
STNT6590 
STNT6600 
STNT6610 
STNT6620 
STNT663@ 
STNT6640 
STNT6650 
STNT6660@ 
STNT6670 
STNT6680 
STNT6690@ 
STNT6700 
STNT6710¢ 
STNT6720 
STNT673@ 
STNT674@ 
STNT6750 
STNT6760 
STNT6770 
STNT6780 
STNT6 790 
STNT6 800 
STNT6810@ 
STNT6820 
STNT6 830 
STNT6846 
STNT685@ 
STNT6860 
STNT6870 
STNT6 880 
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1346 


1366 
138¢ 


1490 


1426 


1440 
146¢ 


3020 


cx 

cx 

c* 
3630 


3040 
3660 

cr 

cx 

cx 
3686 


4000 


4020 
4046 

cx 

cx 

c* 
4120 


NEWQ = NOQPIL 
D=1.D6/RRUP 
IF (D-1.1D@6) 1420, 1406, 14060 
RATIO=RATIO/RRSAME 
IRET = 1 
ISW1=@ 
ISW2=1 
GO TO 3¢0@ 
HNEW = H*D 
NQ = NEWQ 
DO 1466 I=1,N 
D=YMAX (I) 
DO 1446 J=1,NEQ 
D=DMAXK1(D,DABS(Y(I,1,J))) 
YMAX (1)=D 
HNEXT = HNEW 
KNEXT = 3+NQ/5 
RETURN 


THIS SECTION IS USED WHEN STEP-SIZE OR ORDER IS CHANGED 
STARTING VALUES ARE RETRIEVED FROM THE 


DURING THE CYCLE. 
SAVE ARRAY. 


RATIO = DMAX1 (DABS(HMIN/HOLD), DMIN1(RATIO, 1.@D0)) 
T = TOLD 
IF (RATIO.LT.1.@D6) IF (IDEL) 34636, 30306, 30686 
DO 3420 I=1,N 

DY(I,1) = SAVE(9,TI) 

DO 3620 J=1,NQ 

Y(I,J,1) = SAVE(J,1I) 

GO TO (320,266), IRET 


THE (NQST+1)-ST ORDER BACKWARD DIFFERENCE IS ESTABLISHED 


IDEL = NQST+1 
IF ((NQST.LT.2) .OR. (NQ.LT.2)) GO TO 30680 
D = DBLE(FLOAT (NQST) ) 
DO 3060 I=1,N 
D1 = SAVE(9,I) 
DO 3040 J=2,NQST 
Dl = D1 - SAVE(J,1)/DBLE(FLOAT(J-1)) 
SAVE(IDEL,I) = D*D1 


INTERPOLATE FOR NEW POINTS 


DO 314@ I=1,N 
DY(I,1) = RATIO*SAVE(9, I) 
IF (NQ.LT.2) GO TO 314@ 
D1 = 6.@D0 
DO 3120 J=2,NQ 
Dl = D1 + RATIO 
D2 = 1.0D¢ 
D = @.@D¢ 
DO 31¢@ J1=2, IDEL 


D2 = D2*(DBLE(FLOAT(J1-2)) - D1) /DBLE(FLOAT(J1-1)) 


D = D + D2*SAVE(J1,I1) 
Y(1,J,1) = D + SAVE(1,1) 
Y(I,1,1) = SAVE(1,I) 
H = HOLD*RATIO 


FORM THE BACKWARD DIFFERENCES 


IF (NQ.LT.2) GO TO 40646 
NQM1 = NQ-1 
DO 462¢ I=1,N 
DO 4020 J=1,NQM1 
Jd@=J + 1 
DO 44626 J1=J0@,NQ 
J2 = NQ-J1+J+1 
Y(1,J2,1) = Y(I,J2-1,1) - Y(1,J2,1) 
GO TO (320,266,180), IRET 


CONVERGENCE OR ERROR PROBLEMS 


NQ= 1 
GO TO 4164 


STNT6890 
STNT6900 
STNT691¢6 
STNT6920 
STNT69 30 
STNT6940 
STNT695@ 
STNT6960 
STNT6970 
STNT698@ 
STNT699@ 
STNT 7000 
STNT7910 
STNT702@ 
STNT7030 
STNT7046 
STNT7050 
STNT7060 
*STNT70670@ 
*STNT7080 
*STNT7096 
*STNT71060 
*STNT711@ 
STNT7126 
STNT7130@ 
STNT7140 
STNT7156 
STNT7160 
STNT7174 
STNT7180 
STNT719@ 
*STNT7 200 
*STNT72106 
*STNT7220 
STNT7230@ 
STNT7 240 
STNT725@ 
STNT7 260 
STNT72706 
STNT7280 
STNT729@ 
STNT7300 
*STNT7316 
*STNT7 320 
*STNT7 336 
STNT734@ 
STNT735@ 
STNT7 360 
STNT737@ 
STNT738¢@ 
STNT739@ 
STNT74006 
STNT7416 
STNT7420 
STNT7430 
STNT744@0 
STNT7450 
STNT746@ 
STNT747@ 
*STNT748@ 
*STNT749@ 
*STNT7500 
STNT7516 
STNT7520 
STNT753@ 
STNT754@ 
STNT755@ 
STNT7560 
STNT75706 
STNT758@ 
STNT759@ 
*SINT 7600 
*STNT7610 
*STNT 7620 
STNT 76306 
STNT764@ 
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4140 NQ = 2 STNT7650@ 
416% IFAIL = 6 STNT7660 
IRET = 2 STNT767@ 
IWEVAL = +2 STNT768@ 

GO TO 360¢ STNT7690 

418@ KFLAG = -6 STNT7700 
4185 Ji = NQST +1 STNT7710 
DO 419% I=1,N STINT7720 
DY(1I,1) = SAVE(9,I) STNT7730 

DO 419¢ J=1,J1 STNT7740 

4199 Y(1,J,1) = SAVE(J,I) STNT7750 
H = HOLD STNT776@ 

T = TOLD STNT777@ 
JSTART = NQST STNT778@ 
RETURN STNT7790 

C STNT7 800 
CRKRKKKKKKRKKEKRK RE EKEKRERKERERKERKEEKEREEKEEREERERAERERREREKRKERRERKERKKREREREREERSTNT] 810 
c* *STNT7820 
cx --- END OF SUBROUTINE STINT --- *STNT7830 
cx *STNT7840 
CEKKKKKKRKEKRKEKRERKKKERERERKKEREREREREREREERERRE REE RREREKREKREREREEKRREEKERERERES TNT] 856 
Cc STNT7860 
END STNT7870 
SUBROUTINE DEC (N, NDIM, A, IP, IER) DECH 16 


C DECHO 26 


INTEGER N,NDIM, IP, IER,NM1,K,KP1,M,I1,J DECh 36 
DOUBLE PRECISION A, T DECG 44 

Cc DOUBLE PRECISION DABS DECH 5¢@ 
DIMENSION A(NDIM,N), IP(N) DECH 60 
(---------~------------ + - = - - +--+ + + + ee 2 ee 5 ee DEC# 7¢ 
C MATRIX TRIANGULARIZATION BY GAUSSIAN ELIMINATION. DECH 8¢ 
C INPUT.. DECh 9¢ 
Cc N = ORDER OF MATRIX. DECO 160 
Cc NDIM = DECLARED DIMENSION OF ARRAY A. DEC@ 11¢ 
C A = MATRIX TO BE TRIANGULARIZED. DECO 12¢ 
C OUTPUT.. DECO 13¢ 
C A(I,J), I.LE.J = UPPER TRIANGULAR FACTOR, U . DECO 14¢ 
Cc A(I,J), 1.GT.J = MULTIPLIERS = LOWER TRIANGULAR FACTOR, I - L. DEC® 15¢ 
Cc IP(K), K.LT.N = INDEX OF K-TH PIVOT ROW. DEC® 160 
Cc IP(N) = (-1)** (NUMBER OF INTERCHANGES) ORO. DEC# 1706 
Cc IER = @ IF MATRIX A IS NONSINGULAR, OR K IF FOUND TO BE DECH 186 
C SINGULAR AT STAGE K. DECH 190 
C USE SOL TO OBTAIN SOLUTION OF LINEAR SYSTEM. DECO 2060 
C DETERM(A) = IP(N)*A(1,1)*A(2,2)%*...*A(N,N). DEC 210 
C IF IP(N)=0, A IS SINGULAR, SOL WILL DIVIDE BY ZERO. DECG 220 
C DECA 236 
C REFERENCE.. DEC@ 240 
Cc C. B. MOLER, ALGORITHM 423, LINEAR EQUATION SOLVER, DEC 250 
Cc C.A.C.M. 15 (1972), P. 274. DEC 260 
C-----------~----~----------- - -- - - - - = + 5 5 os ee DECO 2706 
IER = @ DEC 280 

IP(N) = 1 DECO 290 

IF (N .EQ. 1) GO TO 7¢ DECO 300 

NM1 =N- 1 DEC® 31¢ 

DO 6@ K = 1,NML DEC® 32¢ 
KPl=K+1 DEC? 33¢@ 

M= kK DECO 34¢ 

DO 16 I = KPL,N DEC@ 350 

10 IF (DABS(A(I,K)) .GT. DABS(A(M,K))) M= I DEC@ 360 
IP(K) = M DEC® 376 

T = A(M,K) DECO 380 

IF (M .EQ. K) GO TO 20 DEC 390 

IP(N) = -IP(N) DEC 400 

A(M,K) = A(K,K) DEC 41¢ 

A(K,K) = T DEC@ 426 

20 IF (T .EQ. @.D@) GO TO 8¢@ DEC@ 430 
T = 1.D@/T DEC® 446 

DO 36 I = KPI,N DECA 454 

30 A(I,K) = -A(1,K)4T DECO 46¢ 
DO 5@ J = KP1,N DECO 476 

T = A(M,J) DECO 480 

A(M,J) = A(K,J) DEC 490 

A(K,J) = T DECO 506¢ 

IF (T .EQ. 0.D@) GO TO 506 DEC@ 516 
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> eS ae ae ee we Ea mp eee oe i ee ee oe Ea 


40 
50 
6@ 
70 


80 


19 
26 


30 
40 
56 


DO 4@ I = KP1,N 
AC(I,J) = A(I,J) + A(1,K)&T 
CONTINUE 
CONTINUE 

K = N 
IF (A(N,N) .EQ. @.D6) GO TO 8¢@ 
RETURN 
IER = K 
IP(N) = @ 
RETURN 


SUBROUTINE SOL (N, NDIM, A, B, IP) 


INTEGER N,NDIM,IP,NM1,K,KP1,M,I,KB,KM1 
DOUBLE PRECISION A,B,T 
DIMENSION A(NDIM,N), B(N), IP(N) 


SOLUTION OF LINEAR SYSTEM, A*¥X =B . 
INPUT.. 

N = ORDER OF MATRIX. 

NDIM = DECLARED DIMENSION OF ARRAY A. 


A = TRIANGULARIZED MATRIX OBTAINED FROM DEC. 


B = RIGHT HAND SIDE VECTOR. 
IP = PIVOT VECTOR OBTAINED FROM DEC. 


DO NOT USE IF DEC HAS SET IER .NE. 6. 
OUTPUT. . 
B = SOLUTION VECTOR, X. 


IF (N .EQ. 1) GO TO 5@ 
NM1 = N - 1 
DO 26 K = 1,NM1 
KP1 =K+1 
M = IP(K) 
T = B(M) 
B(M) = B(K) 
B(K) = T 
DO 16 I = KP1,N 
B(I) = B(I) + AC(I,K)4T 
CONTINUE 
DO 40 KB = 1,NM1 
KM1 = N - KB 
K = KM1 + 1 
B(K) = B(K)/A(K,K) 
T = -B(K) 
DO 3@ I = 1,KM1 


B(I) = B(I) + ACI,K)&T 
CONTINUE 
B(1) = B(1)/A(1,1) 
RETURN 
--~------------------ END OF SUBROUTINE SOL ------------- 
END 


SUBROUTINE DIFFUN(N, T, Y, YDOT) 


DOUBLE PRECISION T, Tl, T2, W1, W2, W3, W4, S, Y, YDOT 


DIMENSION Y(N), YDOT(N) 
T1=-Y (1)+Y¥ (2)+Y (3)+Y¥ (4) 
T2=¥ (1)-Y¥ (2) +Y (3) +Y (4) 
W1=5.D-1* (T1*T1-T2*T2) 
W2=T1*T2 
W3=(Y (1) +Y (2)-Y (3) +¥ (4) ) **2 
W4=(Y¥ (1)+Y (2) +¥ (3)-¥ (4) ) **2 
S=¢.D¢ 
DO 1@ I=1,3 

1@ S=S-1.D—3*Y (1) 
S=S+1.D—-3*Y (4) 


YDOT(1)=-2, 5D-1* (9. 8D2*Y (1) +1. G2D3*Y (2)-9. 8D2*Y (3) +1.02D3*Y (4)-S) 


+ +1.25D-1%* (-W1+W2+W3+W4) 


YDOT(2)=-2. 5D-1* (1. O2D3*Y (1)+9 . 8D2*Y (2)-1. @2D3*¥ (3)+9. 8D2*Y(4)-S) 


+ +1.25D-1* (| W1-W24+W34+W4) 


DECO 
DEC 
DEC 
DECO 
DEC 
DECO 
DEC@ 
DECO 
DEC@ 
DEC@ 
DEC@ 
DEC@ 


SOL@ 
SOLO 
SOLO 
SOLO 
SOLO 
SOLO 
SOLO 
SOLO 
SOLO 
SOLO 
SOL@ 


SOLO 
SOLA 


SOL@ 
SOL@ 
SOL@ 
SOL@ 
SOLO 
SOL@ 
SOL@ 
SOLO 
SOL@ 
SOL@ 
SOLO 
SOL@ 
SOL@ 
SOLO 
SOL@ 
SOL@ 
SOLO 
SOLO 
SOLO 
SOLO 
SOL® 
SOLO 
SOLO 
SOL@ 
SOLO 
SOLO 
SOLO 


TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 
TEST 


160 
110 
126 
134 
146 
150 
166 
170 


YDOT (3)=-2. 5D-1* (-1.62D3*Y (1)-9. 8D2*Y (2)+9. 8D2*Y (3)-1.92D3*Y (4)-S)TEST 180 


+ +1, 25D-1*( W1+W2-W3+W4) 


TEST 


YDOT (4)=-2, 5D-1* (9. 8D2*Y (1) +1. A2D3*Y (2)-1.02D3*Y (3)+9.8D2*Y(4)+S) TEST 


+ +1.25D-1*( W1+W2+W3-W4) 


TEST 


190 
200 
216 
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RETURN 
END 
SUBROUTINE PEDERV(N, T, Y, P@, NO) 
DOUBLE PRECISION P@, Y, T 
DIMENSION P@(16), Y(N) 
PA(1)=(-9.. 8GGO1D2+Y (1) +Y (3) +¥ (4) +3. DO*Y (2) )*2.5D-1 
PQ (5)=(-1.0200G01D3+Y (2)-Y (3)-Y¥ (4)+3. DO*Y (1) )*2.5D-1 
PA(9)=(9. 79999D24+Y (1)-Y (2)-Y (4) +3. DO*Y (3) )*2. 5D--1 
P@(13)=(-1.019999D3+Y (1)-Y (2) -Y¥ (3)+3. DO*Y (4) )*2. 5D-1 
PA(2)=PO(5) 
PO(6)=P9(1) 
PO (10)=-PO (13) 
P@(14)=-P¢ (9) 
PO (3)=PO (10) 
PO(7)=PO6(9) 
P@(11)=PO(1) 
PO(15)=-PO(5) 
PO (4)=PG(14) 
PO(8)=P¢(13) 
PO(12)=P(15) 
PO(16)=PA(1) 
RETURN 
END 
SUBROUTINE ERROR(T, Y, N, ERO) 
DOUBLE PRECISION T, Tl, T2, T3, Wl, W2, W3, W4, X, Y, ER@ 
DOUBLE PRECISION DEXP, DSIN, DCOS, DABS 
DIMENSION ER@(N), Y(N) 
X=1.D14T 
IF(X.GT.1.65D2) GO TO 2¢ 
T1=1.D@+DEXP (-X)* (9 .D@*DCOS (X)+1.D1*DSIN (x) ) 
T2=DEXP (-X)* (1.D1*DCOS (X)-9. @DO*DSIN(X) ) 
IF(DABS(T2).LE.1.D-15) GO TO 1¢ 
T3=1.D1/ (TL¥T1+T24T2) 
GO TO 11 
1@ T3=1.D1/T1**2 
11 Wl=-(T1+T2)*T3 
W2=(T1-T2)*T3 
GO TO 21 
2@ W1=-1.D1 
W2=1.D1 
21 X=1.D3*T 
IF(X.GT.1.65D2) GO TO 22 
W3=5.D2/(1.D@-1.601D3*DEXP (X) ) 
GO TO 23 
22 W3=0.D0 
23 W4=5.D-4/(1.D0-1.9@1D@*DEXP (1.D-3*T) ) 
ERO (1) =-W1+W2+W34+W4 
ER@(2)= W1-W2+W3+W4 
ERO(3)= W1+W2-W3+W4 
ERO(4)= W1+W2+W3-W4 
DO 3@ I=1,N 
36 ER@(1)=ER@(1)-Y (1) 
RETURN 
END 


20 . 
6 


15 
64 


D .90DDHHHDOAODHOD+HH-2 . 9HHHH4HGHHGOOHAD+H9- 1. HGDDOANDHDODOOOD+00 


-1 
Y) 
1 


1 


1 
1 
1 
1 
2 
1 
2 
1 
2 
1 


- PODPDOOAOSSSDOOD+HO 
- PDDDPDODDDDHDDODIHO 1. GOODOODOAAADDDOD+H2 5. 960000040000000D-09 


- $999OOGOOGGOGOOD-03 
- 9$99O00060000000D-05 
- $90000000060000D-67 
- D9DDPSODGHOHDOOD-O 3 
- 9O0000O0GGAGAGD-45 
- 99ODHHOODHDOOOOOD-O7 


220 
230 
246 
250 
260 
276 
280 
290 
300 
319 
320 
330 
340 
350 
360 
370 
380 
390 
Loa 
410 
420 
430 
44d 
450 
460 
470 
480 
490 
500 
510 
520 
530 
540 
550 
560 
57 
580 
590 
600 
610 
626 
630 
640 
650 
660 
674 
680 
690 
700 
710 
720 
730 
740 
750 
760 
770 
780 
790 
800 
810 
820 
830 
840 
850 
860 
870 
880 
890 
900 
910 
920 
930 
940 


534-P16- 


0 


COLLECTED ALGORITHMS FROM ACM 


A AAT AA 


535-P 1- 0 


ALGORITHM 535 


The QZ Algorithm To Solve the Generalized 
Eigenvalue Problem for Complex 
Matrices [F2] 


BURTON S. GARBOW 
Argonne National Laboratory 


Key Words and Phrases: eigenvalues, generalized eigenvalue problem 
CR Categories: 5.14 
Language: Fortran 


DESCRIPTION 


Three Fortran subroutines are provided that implement a complex form of the 
QZ algorithm for finding \ and z such that Az = \Bz, where A and B are complex 
N by N matrices. The subroutines are complex analogs of those for the corre- 
sponding real problem included in the EISPACK eigensystem package [1]; the 
original QZ algorithm is described in [3] and [4]. The complex QZ algorithm 
shares the fundamental property of the real QZ algorithm in being unaffected by 
singularity or near singularity of B. 

Subroutine CQZHES implements the first step of the algorithm wherein A and 
B are simultaneously reduced by unitary transformations to upper Hessenberg 
and upper triangular form, respectively. Subroutine CQZVAL implements an 
iterative process that reduces A to. upper triangular form while maintaining the 
triangular form of B. At the completion of this step, the eigenvalues are derivable 
from the corresponding diagonal elements of the reduced A and B. Finally, if 
eigenvectors are desired, subroutine CQZVEC applies the accumulated transfor- 
mations from the two earlier steps onto the eigenvectors of the triangular problem. 

No facility is provided for obtaining just a few eigenvectors; a subroutine 
employing inverse iteration might be included for this purpose, proceeding from 
the Hessenberg A, the triangular B, and an approximate eigenvalue of the 
problem. Inverse iteration could be expected to save time, but it might be 
somewhat less accurate and reliable, especially in the presence of close eigen- 
values. 

Also, no facility is included for balancing A and B. Optimally scaled matrices 
could result in further improvement of accuracy obtainable with unitary trans- 
formations, but no automatic scaling technique is known at this time. 

The subroutines can be invoked with consecutive statements: 


CALL CQZHES (NM, N, AR, AI, BR, BI, MATZ, ZR, ZI) 
CALL CQZVAL (NM, N, AR, AL, BR, BI, EPS1, ALFR, ALFI, BETA, MATZ, ZR, ZI, 
IERR) : 
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THE FULL MATRIX A OF ORDER 5 IS (PRINTED BY ROWS) 


~238. -344el1 86. 178.41 164. 240.1 -166, -308.1 56. 158.1 
16. 152.1 -~96. -128.1 40. -32.1 60. 184.I -60. -136.! 
118. ~ 284.1 55-2 -182.1 -13. 460.1 34, -192el ~17T6. -214.1 
~314. -160.I 132. T8el 114 296... ~90. -164.I1 424. -374.1 
—54. ~24e! -205~6 -4£00.I 109. 148.1 158. 312-1 -38. —-96.1 
THE FULL MATRIX 8 OF ORDER 5 IS (PRINTED BY ROWS) 

388. 94-1 —-386. -122. I -250. “14.1 556. 130.1 —-396. 626 I 
-304. -76.1 384. 646 I -160. L6~. I —240. -92.1 240. 68. I 
-658. -136.1 -73- 100-1 -109. -250-I -118. 100.[1 406. 96.1 
~640. ~-10.1 204. —-42.I 6926 -90.I1 288. 66.1 -192. 154.1 
-162. -T2e1 631. 158.1 131. 520 ~758. -184%.1 278. T6.1 

ALFR(1) ALFI(T) BETA(I) 
1 3. 299829E O02 *-O6L3LIE 02 4e315166E 02 
2 -1.368646E 02 -1.824827E 02 1.368646E 02 
3 ~5e341594E 02 ~6-231853E 02 1-513450E 03 
4 ~LeIO59L2E 02 —2e223549E 02 5e400093E 02 
5 -9.995206E O1 1.166093E 02 2-831985E 02 
COMPUTED EIGENVALUE ANO EIGENVECTOR RESIDUAL 
1 7.647T050E-01 D441 LTL4E-OL 7-46E-07 
-5.3TO0591E-O1 ~2 «236047 E-02 
-3.185631E-0O1 -1.2£325891E-02 
~3-7131L54E-0O1 -1.545933E-02 
-5.8L0L77E-OL1 ~2.418823E-02 
—-9 .991344E-01 ~4.160066E-02 
2 -1.0Q00000E 00 -1.2333308E 00 4.84E-07 
—2-.592583E-01 -8.606803E-02 
5-94%8840E-01 1.974900E-O1 
8.487330E-01 2-817618E-O1 
9.4906 76E-01 3-L50727E-01 
22 346767E-O1 Te TILOS4E-02 
3 ~3.529415E-01 -4.11L7646E-O1 6-239E-OT 
2-828103E-02 22718275E-OL 
—4.315349E-Ol —~4.140894E-01 
1.024388E-02 32613692E-01 
3.29643 70E-01 9.180620E-01 
~2e121L114E-O1 —~5.1L37083E-OL1 
4 —3.529405E-O1 -4.11L7613E-01 4.82E-OT7 
5 «404448E-01 546249 1L6E-02 
9.812239E-01 1.92871 7E-O1 
8.455181E-O1 9 244063TE-02 
#.273624E-01 -2.57T8912E-02 
~2.842883E-O1 7-4 T6088E-03 
5 -32529399E-01 4.117583E-01 7. 78E-O7? 


1.8448 7T8E-03 
1.966345E-02 
1.144641E-02 
2200562 2E-02 
3575820E-03 


9e193128E-02 
9.801325E-01 
5. 705664E-01 
9.99T990E-O1 
1.782405E-01 


Fig. 1 


and, if IERR is zero and eigenvectors are desired: 


CALL CQZVEC (NM, N, AR, AI, BR, BI, ALFR, ALFI, BETA, ZR, ZI) 


where parameter usage is explained in the algorithm that follows. 

In timing the subroutines on the IBM 370/195, it was found that they run 
between two and three times slower than the corresponding real subroutines for 
systems of the same order. This is felt to be a quite favorable result and is 
attributable chiefly to two factors: (1) double shifts used with real systems to 
avoid complex arithmetic can be replaced by more efficient single shifts here, and 
(2) the amount of complex arithmetic itself can be reduced by choosing one of 
the defining elements of each 2X2 unitary transformation to be real. 

The subroutines provide an alternative to the LZ algorithm developed by 
Kaufman [2] for the solution of the complex generalized eigenproblem. The 
elementary transformations employed in the LZ algorithm, even though stabi- 
lized, do not preclude possible numerical growth with consequent loss of accuracy; 
the unitary transformations employed in the QZ algorithm, on the other hand, 
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are stable. Although unitary transformations require more arithmetic than ele- 
mentary transformations, speed comparisons between the algorithms are compli- 
cated by the fact that the LZ algorithm employs complex operands while the QZ 
algorithm employs programmed complex arithmetic on real operands. With 
certain CDC compilers, for example, it has been demonstrated that formal 
complex arithmetic is more efficient than programmed complex arithmetic, 
thereby strengthening the advantage of the LZ algorithm; in contrast, with the H 
compiler on the IBM 370/195, the reverse is true: the complex QZ algorithm 
actually runs faster than does the LZ algorithm. 

A long precision IBM version of the subroutines was first written and tested on 
the 370/195 at Argonne National Laboratory; the standard single precision 
Fortran version was then derived from it and also tested on the 370/195. There 
are no machine-dependent constants in the subroutines, so the standard version 
should run directly on different machines. 

The example chosen for illustration is the same as that used in [2] and appears 
here as Figure 1. The quantities labeled RESIDUAL are computed as 


|| BAz — «Bazi la/( I 2 a* (Bi Alla + foil | Bll) 


where #; = BETA(I), aj = CMPLX(ALFR(D), ALFI(D)), and z; = CMPLX(ZR 
(*, D, Z1(*, D). 
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ALGORITHM 

NAME(n): indicates a Fortran module with n records 
NAME’: indicates “NAME” is included for testing purposes 
NAMED: indicates ‘“NAME” contains test data 


Contents: CQZHES(281), CQZVAL(382), CQZVEC(138), TEST" (75), 
RMATIN" (65), CGGWZR‘(120), DATA1°(37), DATA2”(36) 


C HES 10 
@ . ipses cist eae ee i es a rea al acer l HES 20 
C HES 30 
SUBROUTINE CQZHES(NM,N,AR,AI,BR,BI,MATZ,ZR,ZI) HES 40 
C HES 50 
INTEGER 1,J,K,L,N,K1,LB,L1,NM,NK1, NMI HES 60 
REAL AR(NM,N),AI(NM,N) ,BR(NM,N) ,BI(NM,N) ,ZR(NM,N) ,Z1(NM,N) HES 70 
REAL R,S,T,TI,U1,U2,XI,XR,Y1,YR,RHO,ULI HES 80 
REAL SQRT,CABS, ABS HES 90 
LOGICAL MATZ HES 100 
COMPLEX CMPLX HES 110 
C HES 120 
C THIS SUBROUTINE IS A COMPLEX ANALOGUE OF THE FIRST STEP OF THE HES 130 
C QZ ALGORITHM FOR SOLVING GENERALIZED MATRIX EIGENVALUE PROBLEMS, HES 140 
C SIAM J. NUMER. ANAL. 10, 241-256(1973) BY MOLER AND STEWART. HES 150 
fs HES 160 
C THIS SUBROUTINE ACCEPTS A PAIR OF COMPLEX GENERAL MATRICES AND HES 170 
C REDUCES ONE OF THEM TO UPPER HESSENBERG FORM WITH REAL (AND NON~ HES 180 
C NEGATIVE) SUBDIAGONAL ELEMENTS AND THE OTHER TO UPPER TRIANGULAR HES 190 
C FORM USING UNITARY TRANSFORMATIONS. IT IS USUALLY FOLLOWED BY HES 200 
C CQZVAL AND POSSIBLY CQZVEC. HES 210 
C HES 220 
C ON INPUT- HES 230 


COLLECTED ALGORITHMS (cont.) 


QA AnKnAaAannanaanananannaanannanananaanananananaanannnnnna 


Q 


10 


20 


25 


NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL 
ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT, 

N IS THE ORDER OF THE MATRICES, 

A=(AR,AI) CONTAINS A COMPLEX GENERAL MATRIX, 


B=(BR,BI) CONTAINS A COMPLEX GENERAL MATRIX, 


MATZ SHOULD BE SET TO .TRUE. IF THE RIGHT HAND TRANSFORMATIONS 


ARE TO BE ACCUMULATED FOR LATER USE IN COMPUTING 
EIGENVECTORS, AND TO .FALSE. OTHERWISE. 


ON OUTPUT- 
A HAS BEEN REDUCED TO UPPER HESSENBERG FORM. THE ELEMENTS 
BELOW THE FIRST SUBDIAGONAL HAVE BEEN SET 1770 ZERO, AND THE 
SUBDIAGONAL ELEMENTS HAVE BEEN MADE REAL (AND NON-NEGATIVE), 


B HAS BEEN REDUCED TO UPPER TRIANGULAR FORM. THE ELEMENTS 


BELOW THE MAIN DIAGONAL HAVE BEEN SET TO ZERO, 


Z=(ZR,Z1) CONTAINS THE PRODUCT OF THE RIGHT HAND 
TRANSFORMATIONS IF MATZ HAS BEEN SET TO .TRUE. 
OTHERWISE, Z IS NOT REFERENCED. 


QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, 
APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY 


AAKKKKEKKK INITIALIZE Z *xxKRKARKR 
IF (.NOT. MATZ) GO TO 10 


po31=1, N 


dpb2J2#1, N 
ZR(I,J) = 0.0 
ZI(I,J) = 0.0 

CONTINUE 


ZR(I,I) = 1.0 
CONTINUE 
RARKKKKKKK REDUCE B TO UPPER TRIANGULAR FORM WITH 
TEMPORARILY REAL DIAGONAL ELEMENTS *#&*k#kkxdK 
IF (N .LE. 1) GO TO 170 
NM1 = N- 1 


po 100 L = 1, NMl 
Ll =L+1 
S = 0.0 


DO 20 I = L, N 
S = S + ABS(BR(I,L)) + ABS(BI(I,L)) 
CONTINUE 


IF (S .EQ. 0.0) GO TO 100 
RHO = 0.0 


DO 25 1#L, N 

BR(I,L) = BR(I,L) / S 

BI(I,L) = BI(I,L) / S 

RHO = RHO + BR(I,L)**2 + BI(I,L)**2 
CONT INUE 


R = SQRT(RHO) 

XR = CABS(CMPLX(BR(L,L) ,BI(L,L))) 
IF (XR .EQ. 0.0) GO TO 27 

RHO = RHO + XR * R 

Ul = -BR(L,L) / XR 

UlI = -BI(L,L) / XR 

YR = R / XR + 1.0 

BR(L,L) = YR * BR(L,L) 

BI(L,L) = YR * BI(L,L) 


240 


400 
410 
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GO TO 28 HES 

Cc HES 
27 BR(L,L) = R HES 

Ul = -1.0 HES 

U1L = 0.0 HES 

Cc HES 
28 DO 50 J = Ll, N HES 

T = 0.0 HES 

TI = 0.0 HES 

C HES 
pO 30 I=L, N HES 

T = T + BR(I,L) * BR(I,J) + BI(I,L) * BI(I,J) HES 

TI = TI + BR(I,L) * BI(1,J) - BI(I,L) * BR(1,J) HES 

30 CONTINUE HES 

C HES 
T = T / RHO HES 

TI = TI / RHO HES 

Cc HES 
po 40 I = L, N HES 

BR(I,J) = BR(I,J) - T * BR(L,L) + TI * BI(I,L) HES 

BI(I,J) = BI(1,J) - T * BI(I,L) - TI * BR(I,L) HES 

40 CONTINUE HES 

C HES 
XI = Ul * BI(L,J) - ULT * BR(L,J) HES 

BR(L,J) = Ul * BR(L,J) + ULL * BI(L,J) HES 

BI(L,J) = XI HES 

50 CONTINUE HES 

Cc HES 
DO 80 J=1,N HES 

T = 0.0 HES 

TI = 0.0 HES 

Cc HES 
DO 60 I=L, N HES 

T = T + BR(I,L) * AR(I,J) + BI(I,L) * AI(I,J) HES 

TI = TI + BR(I,L) * AI(I,J) - BI(I,L) * AR(I,J) HES 

60 CONTINUE HES 

Cc HES 
T = T / RHO HES 

TI = TI / RHO HES 

Cc HES 
pO 70 I=L, N HES 

AR(I,J) = AR(1,J) - T * BR(I,L) + TI * BI(I,L) HES 

AL(1,J) = AL(I,J) - T * BI(I,L) - TI * BR(I,L) HES 

70 CONTINUE HES 

C HES 
XI = Ul * AL(L,J) - UII * AR(L,J) HES 

AR(L,J) = Ul * AR(L,J) + ULI * AL(L,J) HES 

AI(L,J) = XI HES 

80 CONTINUE HES 

Cc HES 
BR(L,L) = R * S HES 

BI(L,L) = 0.0 RES 

C HES 
DO 90 I = LI, N HES 

BR(I,L) = 0.0 HES 

BL(I,L) = 0.0 HES 

90 CONTINUE HES 

C HES 
100 CONTINUE HES 

Cc RAKKKKAKEK REDUCE A TO UPPER HESSENBERG FORM WITH REAL SUBDIAGONALHES 
Cc ELEMENTS, WHILE KEEPING B TRIANGULAR ***x*kkkKKH HES 
DO 160 K = 1, NMl HES 

Kl =K+1 HES 

Cc RRKKKKKKKK SET BOTTOM ELEMENT IN K-TH COLUMN OF A REAL *****x*x%% HES 
TF (AI(N,K) .EQ. 0.0) GO TO 105 HES 

R = CABS(CMPLX(AR(N,K) , AI (N,K))) HES 

Ul = AR(N,K) / R HES 

UlT = AI(N,K) / R HES 

AR(N,K) = R HES 

AI(N,K) = 0.0 HES 

Cc HES 
DO 103 J = Kl, N HES 

XI = Ul * AI(N,J) ~- ULI * AR(N,J) HES 

AR(N,J) = Ul * AR(N,J) + ULI * AI(N,J) HES 

AL(N,J) = XI HES 

103 CONTINUE HES 


1000 
1010 
1020 
1030 
1040 
1050 
1060 
1070 
1080 
1090 
1100 
1110 


1120 
1130 
1140 
1150 
1160 
1170 
1180 
1190 
1200 
1210 
1220 
1230 
1240 
1250 
1260 
1270 
1280 
1290 
1300 
1310 
1320 
1330 
1340 
1350 
1360 
1370 
1380 
1390 
1400 
1410 
1420 
1430 
1440 
1450 
1460 
1470 
1480 
1490 
1500 
1510 
1520 
1530 
1540 
1550 
1560 
1570 
1580 
1590 
1600 
1610 
1620 
1630 
1640 
1650 
1660 
1670 
1680 
1690 
1700 
1710 
1720 
1730 
1740 
1750 
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Cc 


XI = Ul * BI(N,N) - ULL * BR(N,N) 
BR(N,N) = UL * BR(N,N) + ULI * BI(N,N) 


BI(N,N) = XI 
105 IF (K .EQ. NM1) GO TO 170 
NK1 = NM1 - K 


Cc AkKKKAKKAK FOR LaN-] STEP -1 UNTIL K+] DO -- *# kkk RRA 


DO 150 LB = 1, NKIl 


110 


120 
Cc 


130 


L = N - LB 
Ll =L+l1 


RKAKKKKRER ZERO A(L+1L,K) kx 


S = ABS(AR(L,K)) + ABS(AIL(L,K)) + AR(L1,K) 
IF (S .EQ. 0.0) GO TO 150 

Ul = AR(L,K) / S 

U1lI = AI(L,K) / S$ 

U2 = AR(LI1,K) / S 

R = SQRT(UL*U1+U1 1*U1 1+U2*U2) 
Ul = ul / R 

U1I = UlI / R 

U2 = U2 / R 

AR(L,K) = R* S 

AL(L,K) = 0.0 

AR(LI,K) = 0.0 


po 110 J = Kl, N 
XR = AR(L,J) 
XI = AL(L,J) 
YR = AR(L1,J) 
YI = AI(L1,J) 
AR(L,J) = Ul * XR + ULI * XI + U2 * YR 
AI(L,J) = Ul * XI - ULI * XR + U2 * YI 
AR(L1,J) = Ul * YR - ULI * YI - U2 * XR 
AL(L1,J) = Ul * YI + ULI * YR - U2 * XI 
CONTINUE 


XR = BR(L,L) 
BR(L,L) = Ul * XR 
BI(L,L) = -UlI * XR 
BR(L1,L) = -U2 * XR 


DO 120 J = Ll, N 
XR = BR(L,J) 
XI = BI(L,J) 
YR = BR(LI,J) 
YI = BI(LI,J) 
BR(L,J) = UL * XR + ULI * XL + U2 * YR 
BI(L,J) = Ul * XI - ULI * XR + U2 * YI 
BR(L1,J) = Ul * YR - ULI * YI - U2 * XR 
BI(L1,J) = Ul * YI + U1I * YR - U2 * XI 
CONTINUE 


RKKEKKKAKKK ZERO B(L+L,L) ke R ARR 


S = ABS(BR(L1,L1)) + ABS(BI(L1,L1)) + ABS(BR(L1,L)) 
IF (S .EQ. 0.0) GO TO 150 

Ul = BR(LI,L1) / $ 

UlI = BI(LI,L1) / S 

U2 = BR(LI1,L) / S 

R = SQRT(UL*U1+U1 1*U1L1+U2*U2) 
Ul = UL / R 

UlI = UlL / R 

U2 = U2 /R 

BR(L1,L1) = R * S 

BI(LI,L1) = 0.0 

BR(L1,L) = 0.0 


pO 130 T= 1, L 
XR = BR(I,L1) 
XI = BI(I,L1) 
YR = BR(I,L) 
YI = BI(I,L) 
BR(I,L1) = UL * XR + UlI * XI + U2 * YR 
BI(I,L1) = Ul * XI - ULI * XR + U2 * YI 
BR(I,L) = Ul * YR - U1I * YI - U2 * XR 
BI(I,L) = Ul * YI + UII * YR - U2 * XI 
CONTINUE 


DO 140 I= 1, N 


HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 
HES 


1760 
1770 
1780 
1790 
1800 
1810 
1820 
1830 
1840 
1850 
1860 
1870 
1880 
1890 
1900 
1910 
1920 
1930 
1940 
1950 
1960 
1970 
1980 
1990 
2000 
2010 
2020 
2030 
2040 
2050 
2060 
2070 
2080 
2090 
2100 
2110 
2120 
2130 
2140 
2150 
2160 
2170 
2180 
2190 
2200 
2210 
2220 
2230 
2240 
2250 
2260 
2270 
2280 
2290 
2300 
2310 
2320 
2330 
2340 
2350 
2360 
2370 
2380 
2390 
2400 
2410 
2420 
2430 
2440 
2450 
2460 
2470 
2480 
2490 
2500 
2510 
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aa 
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XR = AR(I,L1) HES 

XI = AI(I,L1) HES 

YR = AR(I,L) HES 

YI = AI(I,L) HES 

AR(I,L1) = Ul * XR + ULI * XI + U2 * YR HES 

AI(I,L1) = Ul * XI - UII * XR + U2 * YI HES 

AR(I,L) = Ul * YR - ULI * YI - U2 * XR HES 

AI(I,L) = UL * YI + ULI * YR - U2 * XI HES 

140 CONTINUE HES 
HES 

IF (.NOT. MATZ) GO TO 150 HES 

HES 

pO 145 12#1,N HES 

XR = ZR(I,L1) HES 

XI = ZI(I,L1) HES 

YR = ZR(I,L) HES 

YI = ZI(I,L) HES 

ZR(I,L1) = Ul * XR + ULI * XI + U2 * YR HES 

ZI(I,L1) = Ul * XI = ULI * XR + U2 * YI HES 

ZR(I,L) = Ul * YR - ULI * YI - U2 * XR HES 

ZI(I,L) = Ul * YI + ULI * YR = U2 * XI HES 

145 CONTINUE HES 
HES 

150 CONTINUE HES 
HES 

160 CONTINUE HES 
HES 

170 RETURN HES 
AAKKKKKEKK LAST CARD OF CQZHES ***#kkkAAKK HES 
END HES 
VAL 

-------------------~------------- w------------- +--+ == = -VAL 
VAL 

SUBROUTINE CQZVAL(NM,N,AR,AL,BR,BI,EPS1,ALFR,ALFI,BETA, VAL 
X MATZ,ZR, ZI, IERR) VAL 
VAL 

INTEGER I,J,K,L,N,EN,K1,K2,LL,L1,NA,NM,ITS,KMI1,LM1, VAL 
X ENM2 , IERR,LOR1 , ENORN VAL 
REAL AR(NM,N) ,AI(NM,N) ,BR(NM,N),BI(NM,N) ,ALFR(N) ,ALFI(N), VAL 
% BETA(N) ,ZR(NM,N) ,Z1(NM,N) VAL 
REAL R,S,Al1,A2,EP,SH,U1,U2,X1,XR,YI,YR,ANI,A11,A33,A34,A43,A44, VAL 
X BNI,B11,B33,B44, SHI,U11I,A331 ,A341,A431 ,A441,B331,B441, VAL 
x EPSA,EPSB, EPS1, ANORM, BNORM, B3344,B33441 VAL 
REAL SQRT,CABS, ABS VAL 
INTEGER MAXO VAL 
LOGICAL MATZ VAL 
COMPLEX 23 VAL 
COMPLEX CSQRT,CMPLX VAL 
REAL REAL, AIMAG VAL 
VAL 

VAL 

VAL 

VAL 

VAL 

THIS SUBROUTINE IS A COMPLEX ANALOGUE OF STEPS 2 AND 3 OF THE VAL 
QZ ALGORITHM FOR SOLVING GENERALIZED MATRIX EIGENVALUE PROBLEMS, VAL 
SIAM J. NUMER. ANAL. 10, 241-256(1973) BY MOLER AND STEWART, VAL 
AS MODIFIED IN TECHNICAL NOTE NASA TN E-7305(1973) BY WARD. VAL 
VAL 

THIS SUBROUTINE ACCEPTS A PAIR OF COMPLEX MATRICES, ONE OF THEM VAL 
IN UPPER HESSENBERG FORM AND THE OTHER IN UPPER TRIANGULAR FORM, VAL 
THE HESSENBERG MATRIX MUST FURTHER HAVE REAL SUBDIAGONAL ELEMENTS. VAIL 
IT REDUCES THE HESSENBERG MATRIX TO TRIANGULAR FORM USING VAL 
UNITARY TRANSFORMATIONS WHILE MAINTAINING THE TRIANGULAR FORM VAL 
OF THE OTHER MATRIX AND FURTHER MAKING ITS DIAGONAL ELEMENTS VAL 
REAL AND NON-NEGATIVE. IT THEN RETURNS QUANTITIES WHOSE RATIOS VAL 
GIVE THE GENERALIZED EIGENVALUES. IT IS USUALLY PRECEDED BY VAL 
CQZHES AND POSSIBLY FOLLOWED BY CQZVEC. VAL 
VAL 

ON INPUT- VAL 
VAL 

NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL VAL 
ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM VAL 
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AAAAANAAAAAAAANAARAANAAANANAANAANAANAANAANANANAAANANNAAANAANMNANAAMANANANNAANAANAAANANAAAN 


Qa 


DIMENSION STATEMENT, 
N IS THE ORDER OF THE MATRICES, 


A=(AR,AI) CONTAINS A COMPLEX UPPER HESSENBERG MATRIX 
WITH REAL SUBDIAGONAL ELEMENTS, 


B=(BR,BI) CONTAINS A COMPLEX UPPER TRIANGULAR MATRIX, 


EPS1 IS A TOLERANCE USED TO DETERMINE NEGLIGIBLE ELEMENTS. 
EPS1 = 0.0 (OR NEGATIVE) MAY BE INPUT, IN WHICH CASE AN 
ELEMENT WILL BE NEGLECTED ONLY IF IT IS LESS THAN ROUNDOFF 
ERROR TIMES THE NORM OF ITS MATRIX. IF THE INPUT EPS1 IS 
POSITIVE, THEN AN ELEMENT WILL BE CONSIDERED NEGLIGIBLE 
IF IT IS LESS THAN EPS] TIMES THE NORM OF ITS MATRIX. A 
POSITIVE VALUE OF EPS1 MAY RESULT IN FASTER EXECUTION, 

BUT LESS ACCURATE RESULTS, 


MATZ SHOULD BE SET TO .TRUE. IF THE RIGHT HANI) TRANSFORMATIONS 
ARE TO BE ACCUMULATED FOR LATER USE IN COMPUTING 
EIGENVECTORS, AND TO .FALSE. OTHERWISE, 


Z=(ZR,ZI) CONTAINS, IF MATZ HAS BEEN SET TO .TRUE., THE 
TRANSFORMATION MATRIX PRODUCED IN THE REDUCTION 
BY CQZHES, IF PERFORMED, OR ELSE THE IDENTITY MATRIX. 
IF MATZ HAS BEEN SET TO .FALSE., Z IS NOT REFERENCED. 


ON OUTPUT- 


A HAS BEEN REDUCED TO UPPER TRIANGULAR FORM. THE ELEMENTS 
BELOW THE MAIN DIAGONAL HAVE BEEN SET TO ZERO, 


B IS STILL IN UPPER TRIANGULAR FORM, ALTHOUGH ITS ELEMENTS 
HAVE BEEN ALTERED. IN PARTICULAR, ITS DIAGONAL HAS BEEN SET 
REAL AND NON-NEGATIVE. THE LOCATION BR(N,1) IS USED TO 
STORE EPS] TIMES THE NORM OF B FOR LATER USE BY CQZVEC, 


ALFR AND ALFI CONTAIN THE REAL AND IMAGINARY PARTS OF THE 
DIAGONAL ELEMENTS OF THE TRIANGULARIZED A MATRIX, 


BETA CONTAINS THE REAL NON-NEGATIVE DIAGONAL ELEMENTS OF THE 
CORRESPONDING B. THE GENERALIZED EIGENVALUES ARE THEN 
THE RATIOS ((ALFR+I*ALFI) /BETA) , 


Z CONTAINS THE PRODUCT OF THE RIGHT HAND TRANSFORMATIONS 
(FOR BOTH STEPS) IF MATZ HAS BEEN SET TO .TRUE., 


IERR IS SET TO 
ZERO FOR NORMAL RETURN, 
J IF AR(J,J-1) HAS NOT BECOME 
ZERO AFTER 50 ITERATIONS. 


QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, 
APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY 


IERR = 0 

kkAKKKKKKK COMPUTE EPSA,EPSB *# kt KKH 
ANORM = 0.0 

BNORM = 0.0 


pO 30 1=1, N 
ANI = 0.0 
IF (I .NE. 1) ANI = ABS(AR(I,I-1)) 
BNI = 0.0 


po 20 J=1,N 
ANI = ANI + ABS(AR(1,J)) + ABS(AI(1,J)) 
BNI = BNI + ABS(BR(1,J)) + ABS(BI(I,J)) 
20 CONTINUE 


IF (ANI .GT. ANORM) ANORM = ANIL 
IF (BNI .GT. BNORM) BNORM = BNI 
30 CONTINUE 
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40 


50 


60 


70 


80 


90 


95 


97 


98 


100 


IF (ANORM .EQ. 0.0) ANORM = 
IF (BNORM .EQ. 0.0) BNORM 
EP = EPS1 

IF (EP .GT. 0.0) GO TO 50 


l 
— 
oo 


RRKKKKKKKK COMPUTE ROUNDOFF LEVEL IF EPS1 IS ZERO ***kxeaaKK 


EP = 1.0 

EP = EP / 2.0 

IF (1.0 + EP .GT. 1.0) GO TO 40 

EPSA = EP * ANORM 

EPSB = EP * BNORM 

HKKKKKKKKK REDUCE A TO TRIANGULAR FORM, WHILE 
KEEPING B TRIANGULAR ****kkkkK 

LORI = 1 

ENORN = N 

EN = N 

RKKKKKKKKK BEGIN QZ STEP kkkkkkkakk 

IF (EN .EQ. 0) GO TO 1001 

IF (.NOT. MATZ) ENORN = EN 

Its = 0 

NA = EN - 1 

ENM2 = NA - 1 


AnAKKRRKKK CHECK FOR GONVERGENCE OR REDUCIBILITY. 
FOR L=EN STEP -1 UNTIL 1 DO -— ##kkARKKKK 


DO 80 LL = l, EN 

LM1L = EN - LL 

L = LMl + 1 

IF (L .EQ. 1) GO TO 95 

IF (ABS(AR(L,LM1)) .LE. EPSA) GO TO 90 
CONTINUE 


AR(L,LM1) = 0.0 


HAAKKAKKAK SET DIAGONAL ELEMENT AT TOP OF B REAL **xk*kxxKK 


Bll = CABS(CMPLX(BR(L,L),BI(L,L))) 
IF (BL(L,L) .EQ. 0.0) GO TO 98 

Ul = BR(L,L) / Bll 

U1I = BI(L,L) / B1l 


DO 97 J = L, ENORN 
XI = UL * AI(L,J) - ULI * AR(L,J) 
AR(L,J) = UL * AR(L,J) + ULI * AI(L,J) 


AI(L,J) = XI 
Xl = Ul * BI(L,J) - ULI * BR(L,J) 
BR(L,J) = UL * BR(L,J) + ULI * BI(L,J) 
BI(L,J) = XI 

CONT [NUE 


BI(L,L) = 0.0 

IF (L .NE. EN) GO TO 100 

kkhkeRKKKKKK 1-BY-1l BLOCK ISOLATED KkKKKKKKRKK 
ALFR(EN) = AR(EN, EN) 

ALFI(EN) = AI(EN,EN) 

BETA(EN) = Bll 

EN = NA 

GO TO 60 

kKkKKKKKRKK CHECK FOR SMALL TOP OF B KkeAKKKKKKK 
Ll =L+1 

IF (Bll .GT. EPSB) GO TO 120 

BR(L,L) = 0.0 

S = ABS(AR(L,L)) + ABS(AI(L,L)) + ABS(AR(L1,L)) 
Ul = AR(L,L) / S 

UlI = AI(L,L) / S 

U2 = AR(LI,L) / $ 

R = SQRT(UL*U1L+U1L1*U11+U2*U2) 

Ul = Ul / R 

UlI = Ull / R 

U2 = U2 /R 

AR(L,L) = R* S 

AI(L,L) = 0.0 


DO 110 J = Ll, ENORN 
XR = AR(L,J) 
XI = AL(L,J) 
YR = AR(LI,J) 
YI = AI(L1,J) 
AR(L,J) = Ul * XR + UII * XI + U2 * YR 
AI(L,J) = Ul * XI - UII * XR + U2 * YT 
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110 


120 


122 


124 


125 


AR(L1,J) = Ul * YR - ULI * YI - U2 * XR 
AI(L1,J) = Ul * YI + ULI * YR ~ U2 * XI 
XR = BR(L,J) 

XI = BI(L,J) 

YR = BR(LI1,J) 

YI = BI(LI,J) 

BR(L1,J) = Ul * YR - ULI * YI - U2 * XR 
BR(L,J) = Ul * XR + ULI * XI + U2 * YR 

BI(L,J) = UL * XI - ULI * XR + U2 * YI 

BI(L1,J) = UL * YI + ULI * YR - U2 * XI 

CONTINUE 


LML = L 

L = Ll 

GO TO 90 

kkKKK KKK ITERATION STRATEGY KRKKKKKKKRK 
IF (ITS .EQ. 50) GO TO 1000 

IF (ITS .EQ. 10) GO TO 135 

kkrkkkkkkker DETERMINE SHLFT ***4kxkxkKK 

B33 = BR(NA,NA) 

B331 = BI(NA,NA) 

IF (CABS(CMPLX(B33,B33I)) .GE. EPSB) GO TO 122 
B33 = EPSB 

B331 = 0.0 

B44 = BR(EN,EN) 

B44I = BI(EN,EN) 

IF (CABS(CMPLX(B44,B44I)) .GE. EPSB) GO TO 124 
B44 = EPSB 

B44I = 0.0 

B3344 = B33 * B44 - B33I * B44I 

B33441 = B33 * B441 + B33I * B44 

A33 = AR(NA,NA) * B44 - AI(NA,NA) * B441 
A33I = AR(NA,NA) * B44I + AI(NA,NA) * B44 
A34 = AR(NA,EN) * B33 - AI(NA,EN) * B331 


4 - AR(NA,NA) * BR(NA,EN) + AI(NA,NA) * BI(NA,EN) 
A34I = AR(NA,EN) * B33I + AI(NA,EN) * B33 
X - AR(NA,NA) * BI(NA,EN) — AI(NA,NA) * BR(NA,EN) 


A43 = AR(EN,NA) * B44 
A43I = AR(EN,NA) * B44I 


A44 = AR(EN,EN) * B33 - AI(EN,EN) * B33I - AR(EN,NA) * BR(NA,EN) 
A441 = AR(EN,EN) * B33I + AI(EN,EN) * B33 - AR(EN,NA) * BI(NA,EN) 


SH = A4&4 
SHI = AG4I 
XR = A34 * A43 ~ A341 * AG3I 
XI = A34 * AG3I + A341 * AG3 
IF (XR .EQ. 0.0 .AND. XI .EQ. 0.0) GO TO 140 
YR = (A33 - SH) / 2.0 
YI = (A33I - SHI) / 2.0 
Z3 = CSQRT (CMPLX(YR**2-YI**2+XR, 2.O*YR*YI+X1) ) 
Ul = REAL(Z3) 
ULI = AIMAG(Z3) 
IF (YR * Ul + YI * ULI .GE. 0.0) GO TO 125 
UL = -Ul 
U1I = -UlI 
Z3 = (CMPLX(SH,SHI) - CMPLX(XR,XI) / CMPLX(YR+U1,YI+U1I)) 
X  / CMPLX(B3344,B33441) 
SH = REAL(Z3) 
SHI = AIMAG(Z3) 
GO TO 140 
RKKKKKRKKK AD HOC SHIFT khkkhkkhhhk 
SH = AR(EN,NA) + AR(NA,ENM2) 
SHI = 0.0 
kkRKKKKAKK DETERMINE ZEROTH COLUMN OF A *#&ekaeAKK 
Al = AR(L,L) / Bll - SH 
ALI = AI(L,L) / Bll - SHI 
A2 = AR(LI,L) / Bll 
ITS = ITS + 1 
IF (.NOT. MATZ) LOR1 = L 
KREKKKKKEKE MAIN LOOP RkRAKKKKAK 
DO 260 K = L, NA 
Kl =K+1 
K2 =K+2 
KM] = MAXO(K-1,L) 
HRRRREKKKRK ZERO A(K+1L,K-L) xe RRKKAKKK 
IF (K .EQ. L) GO TO 170 
Al = AR(K,KM1) 
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170 


180 


C 
240 


245 


250 


All = AI(K,KM1) 
A2 = AR(K1,KM1) 
S = ABS(Al) + ABS(A1I) + ABS(A2) 


Ul = Al / S 

UlI = All / S 

u2 = A2/S 

R = SQRT(UL*UL+U11*U11+U2*U2) 
ul = UL / R 

ULI = ULI / R 

U2 = U2 /R 


DO 180 J = KMl, ENORN 
XR = AR(K,J) 
XI = AL(K,J) 
YR = AR(K1,J) 
Yl = AI(K1,J) 
AR(K,J) = UL * XR + ULI * XI + U2 * YR 
AI(K,J) = Ul * XI - ULI * XR + U2 * YI 
AR(KI,J) = Ul * YR - ULI * YI -— U2 * XR 
AI(KL,J) = Ul * YI + ULI * YR - U2 * XI 
XR = BR(K,J) 
XI = BI(K,J) 
YR = BR(K1,J) 
YI = BI(KI,J) 
BR(K,J) = Ul * XR + ULL * XI + U2 * YR 
BI(K,J) = Ul * XI - ULI * XR + U2 * YI 
BR(K1,J) = Ul * YR - ULI * YI - U2 * XR 
BL(KI,J) = Ul * YI + ULI * YR - U2 * XI 
CONTINUE 


IF (K- .EQ. L) GO TO 240 
AI(K,KM1) = 0.0 
AR(K1,KM1) = 0.0 
AI(K1,KM1) = 0.0 


RRKKKKKKKK ZERO B(K+L,K) *eRRAAKKKK 


S = ABS(BR(K1,K1)) + ABS(BI(K1,K1)) + ABS(BR(K1,K) ) 
Ul = BR(KI,K1) / § 

U1I = BI(KI1,K1) / S 

U2 = BR(KI,K) / S 

R = SQRT(UL*U14+UL1*U11I+U24U2) 
Ul = Ul / R 

UlI = UlI / R 

U2 = U2 / R 

IF (K .EQ. NA) GO TO 245 

XR = AR(K2,K1) 

AR(K2,K1) = Ul * XR 

AL(K2,K1) = -U1I * XR 
AR(K2,K) * -U2 * XR 


pO 250 I = LORI, Kl 
XR = AR(I,K1) 
XI = AI(I,K1) 
YR = AR(I,K) 
YI = AI(1,K) 
AR(I,K1) = Ul * XR + ULI * XI + U2 * YR 
AL(I,Kl1) = Ul * XI - ULI * XR + U2 * YI 
AR(I,K) = Ul * YR - ULI * YI - U2 * XR 
A1(1,K) = Ul * YI + ULI * YR - U2 * XI 
XR = BR(I,K1) 
XI = BI(1,K1) 
YR = BR(1,k) 
YI = BI(I,K) 
BR(I,K1) = Ul * XR + ULI * XI + U2 * YR 
BI(1,Kl1) = Ul * XI - ULI * XR-+ U2 * YI 
BR(I,K) = Ul * YR - ULL * YI - U2 * XR 
BI(I,K) = Ul * YI + ULI * YR - U2 * XI 
CONTINUE 


BI(K1,Kl1) = 0.0 
BR(K1,K) = 0.0 
BI(K1,K) = 0.0 
IF (.NOT,. MATZ) GO TO 260 


pO 255 I = 1, N 
XR = ZR(I,K1) 
XI = Z1(1,K1) 
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255 
Cc 


YR = ZR(I,K) 

YI = ZI(I,K) 

ZR(I,K1) = Ul * XR + ULI * XI + U2 * YR 

ZI(1,K1) = Ul * XI - ULI * XR + U2 * YI 

ZR(I,K) = Ul * YR - ULI * YI - U2 * XR 

ZI(1,K) = Ul * YI + ULI * YR = U2 * XI 
CONTINUE 


260 CONTINUE 


C 


aaa 


MQANQAANAANANRAANMANANRARANANANAANRAANnNRaaaAnNNn 


akRKKKKKKK SET LAST A SUBDIAGONAL REAL AND END QZ STEP *#kkkRKHRE 


IF (AL(EN,NA) .EQ. 0.0) GO TO 70 

R = CABS(CMPLX(AR(EN,NA) ,AL(EN,NA) )) 
Ul = AR(EN,NA) / R 

U1I = AI(EN,NA) / R 

AR(EN,NA) = R 

AI(EN,NA) = 0.0 


DO 270 J = EN, ENORN 
XI = Ul * AI(EN,J) - ULI * AR(EN,J) 
AR(EN,J) = Ul * AR(EN,J) + ULI * AL(EN,J) 
AI(EN,J) = XI 
XI = Ul * BI(EN,J) - UII * BR(EN,J) 
BR(EN,J) = Ul * BR(EN,J) + ULI * BI(EN,J) 
BI(EN,J) = XI 

CONTINUE 


GO TO 70 

kkKKKKEKKK SET ERROR -- BOTTOM SUBDIAGONAL ELEMENT HAS NOT 
BECOME NEGLIGIBLE AFTER 50 ITERATIONS **#ekkkKHH 

IERR = EN 

HKKKKKKKKR SAVE EPSB FOR USE BY CQZVEC *kkeARAAKK 

IF (N .GT. 1) BR(N,1) = EPSB 

RETURN 

KkKKKKKKKE LAST CARD OF CQZVAL KKKKKKKRKKK 

END 


SUBROUTINE CQZVEC(NM,N,AR,AI, BR, BI, ALFR,ALFI, BETA,ZR,Z1) 


INTEGER 1,J,K;M,N,EN,1II,JJ,NA,NM,NN 
REAL AR(NM,N),AI(NM,N) ,BR(NM,N) ,BI(NM,N) ,ALFR(N) ,ALFI(N), 


xX BETA(N) ,ZR(NM,N) ,Z1(NM,N) 


REAL R,T,RI,TI,XI, ALMI,ALMR, BETM, EPSB 
REAL CABS 

COMPLEX 23 

COMPLEX CMPLX 

REAL REAL, AIMAG 


THIS SUBROUTINE IS A COMPLEX ANALOGUE OF THE FOURTH STEP OF THE 
QZ ALGORITHM FOR SOLVING GENERALIZED MATRIX EIGENVALUE PROBLEMS, 
SIAM J. NUMER. ANAL. 10, 241-256(1973) BY MOLER AND STEWART. 


THIS SUBROUTINE ACCEPTS A PAIR OF COMPLEX MATRICES IN UPPER 


TRIANGULAR FORM, WHERE ONE OF THEM FURTHER MUST HAVE REAL DIAGONALVEC 
ELEMENTS. IT COMPUTES THE EIGENVECTORS OF THE TRIANGULAR PROBLEM VEC 
AND TRANSFORMS THE RESULTS BACK TO THE ORIGINAL COORDINATE SYSTEM. VEC 


IT IS USUALLY PRECEDED BY CQZHES AND CQZVAL. 
ON INPUT- 

NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL 
ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT, 

N IS THE ORDER OF THE MATRICES, 


A=(AR,AL) CONTAINS A COMPLEX UPPER TRIANGULAR MATRIX, 


VEC 


VEC 


B=(BR,BI) CONTAINS A COMPLEX UPPER TRIANGULAR MATRIX WITH REAL VEC 
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aannnanaanaanagnannaananagananaannanangaananaann 


aaa 


605 


610 


700 


800 


DIAGONAL ELEMENTS. IN ADDITION, LOCATION BR(N,1) CONTAINS 
THE TOLERANCE QUANTITY (EPSB) COMPUTED AND SAVED IN CQZVAL, 


ALFR, ALFI, AND BETA ARE VECTORS WITH COMPONENTS WHOSE 
RATIOS ((ALFR+I*ALFI)/BETA) ARE THE GENERALIZED 
EIGENVALUES. THEY ARE USUALLY OBTAINED FROM CQZVAL, 


Z=(ZR,ZI) CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE 
REDUCTIONS BY CQZHES AND CQZVAL, IF PERFORMED. 
IF THE EIGENVECTORS OF THE TRIANGULAR PROBLEM ARE 
DESIRED, Z MUST CONTAIN THE IDENTITY MATRIX. 


ON OUTPUT- 
A IS UNALTERED, 
B HAS BEEN DESTROYED, 
ALFR, ALFI, AND BETA ARE UNALTERED, 


Z CONTAINS THE EIGENVECTORS. EACH EIGENVECTOR IS NORMALIZED 
SO THAT THE MODULUS OF ITS LARGEST COMPONENT IS 1.0. 


QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, 
APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY 


IF (N .LE. 1) GO TO 1001 
EPSB = BR(N,1) 
kkhkkkkkeee FOR EN#*N STEP -l UNTIL 2 DO -- KRAKKKKKKRKK 
DO 800 NN = 2, N 
EN = N + 2 - NN 
NA = EN - 1 
ALMR = ALFR(EN) 
ALMI = ALFI(EN) 
BETM = BETA(EN) 
KkKKKKKKKK FOR IsEN-l1 STEP -) UNTIL 1 DO -= HEKKKKKKEKK 
DO 700 II = 1, NA 
I = EN -II 
R = 0.0 
RI = 0.0 
M=I¢1l 


DO 610 J = M, EN 
T = BETM * AR(I,J) - ALMR * BR(I,J) + ALMI * BI(I,J) 
TI = BETM * AI(I,J) - ALMR * BI(I,J) - ALMI * BR(I,J) 
IF (J .EQ. EN) GO TO 605 
XI = T * BI(J,EN) + TI * BR(J,EN) 
T = T * BR(J,EN) - TI * BI(J,EN) 
TI = XI 
R=R+T 
RI = RI + TI 
CONTINUE 


T = ALMR * BETA(I) - BETM * ALFR(1) 
TI = ALMI * BETA(I) - BETM * ALFI(L) 
IF (T .EQ. 0.0 .AND. TI .EQ. 0.0) T = EPSB 
Z3 = CMPLX(R,RI) / CMPLX(T,TI) 
BR(I,EN) = REAL(Z3) 
BI(1,EN) = AIMAG(Z3) 
CONTINUE 


CONTINUE 
RRKKKKKEKK END BACK SUBSTITUTION. 
TRANSFORM TO ORIGINAL COORDINATE SYSTEM. 
FOR J=N STEP -1 UNTIL 2 DO -— ¥kxkAKKRKKK 
DO 880 JJ = 2, N 
J=N+t+2- JJ 
MeJ-l 


DO 880 I = 1, N 


DO 860 K= 1, M 


VEC 


ZR(I,J) = ZR(I,J) + ZR(I,K) * BR(K,J) - ZI(1I,K) * BI(K,J)VEC 
ZI(I,J) = ZI(I,J) + ZR(I,K) * BI(K,J) + ZI(1,K) * BR(K,J) VEC 


1150 
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AANAAANCaAaAaAaA 


860 CONTINUE VEC 
VEC 

880 CONTINUE VEC 
kkkKKKKKKK NORMALIZE SO THAT MODULUS OF LARGEST VEC 
COMPONENT OF EACH VECTOR IS ] ¥*kkkkkKHK VEC 

po 950 J=1, N VEC 

T = 0.0 VEC 

VEC 

DO 930 I = 1, N VEC 

R = CABS (CMPLX(ZR(1,J),Z1(1,J))) VEC 

IF (R .CGT. T) T]@R VEC 

930 CONT [NUE VEC 
VEC 

DO 940 I = 1, N VEC 
ZR(L,J) = ZR(L,J) / T VEC 

ZI(1,J) = ZI1(1,J) / T VEC 

940 CONTINUE VEC 
VEC 

950 CONTINUE VEC 
VEC 

1001 RETURN VEC 
KRKEKKKKKAKK LAST CARD OF CQZVEC RkRRKKKKKK VEC 
END VEC 
CGG 

THIS DRIVER TESTS QZ FOR THE CLASS OF COMPLEX GENERALIZED MATRIXCGG 
SYSTEMS EXHIBITING THE USE OF QZ TO FIND ALL THE EIGENVALUES CGG 
AND ELGENVECTORS FOR THE ELGENPROBLEM A*X = (LAMBDA)*B*X . CGG 
CGG 

THE DIMENSION OF A,AI,B,BI,Z, AND ZI SHOULD BE NM BY NM. CGG 
THE DIMENSION OF ALFR,ALFI,BETA, AND NORM SHOULD BE JM. CGG 
THE DIMENSION OF AHOLD AND BHOLD SHOULD BE NM BY JNM. CGG 
THE DIMENSION OF AHOLDI AND BHOLDI SHOULD BE NM BY NM. CGG 
HERE NM = 20. CGG 
CGG 

REAL A( 20, 20),B( 20, 20),Z( 20, 20), CGG 

$ ALFR( 20),ALFI( 20),BETA( 20),NORM( 20), CGG 

$ RESDUL,EPS1, A1I(20, 20) ,BI(20, 20) ,Z21(20,20), CGG 

$ AHOLD( 20, 20),BHOLD( 20, 20), AHOLDI(20,20) ,BHOLDI(20,20)CGG 
REAL AMAX1 CGG 
INTEGER ERROR CGG 
DATA IWRITE/6/ CGG 
CGG 

NM = 20 CGG 

10 CALL RMATIN(NM,N,A,B, AHOLD, BHOLD,0) CGG 
CALL RMATIN(NM,N,AI, BI, AHOLDI, BHOLDI,0) CGG 
WRITE (IWRITE, 20) CGG 

$ N CGG 
20 FORMAT(30HITHE FULL MATRIX A OF ORDER, CGG 
$ 14,22H IS (PRINTED BY ROWS) /) CGG 
pO 30 I = 1,N CGG 

30 WRITE (1WRITE, 40) CGG 
$ (A(1,J),AI(1,J),J=1,N) CGG 
40 FORMAT (5(2F6.0, 1H1, 3X) ) CGG 
WRLITE(IWRITE, 41) CGG 

$ N CGG 
41 FORMAT(30HOTHE FULL MATRIX B OF ORDER, CGG 
$ 14,22H IS (PRINTED BY ROWS)/) CGG 
DO 42 I = 1,N CGG 

42 WRITE (IWRITE, 43) CGG 
$ (B(I,J),BI(1,J),J=1,N) CGG 
43 FORMAT (5(2F6.0, LHI,3X)) CGG 
CGG 

EIGENVALUES AND EIGENVECTORS USING CQZVAL AND CQZVEC CGG 
CGG 

EPS] = 0.0 CGG 

CALL CQZHES(NM,N,A,AI,B,BI,.TRUE.,Z,Z1) CGG 

CALL CQZVAL(NM,N,A,AI,B,BI,EPS1,ALFR,ALFI,BETA, CGG 

$ . TRUE. ,Z,Z1, ERROR) CGG 
CALL CQZVEC(NM,N,A,AI,B,BI,ALFR,ALFI,BETA,Z,Z1) CGG 
WRITE(IWRITE, 292) CGG 

292 FORMAT (/15X, 7HALFR(1) ,19X, 7HALFI (I) ,19X, 7HBETA(I)) CGG 
DO 295 I = 1,N CGG 
WRITE (IWRITE, 293) CGG 

$ 1, ALFR(I) ,ALFI(I) , BETA(I) CGG 


535-P14- 


0 


COLLECTED ALGORITHMS (cont.) 


C 


Cc 


C 
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293 FORMAT (12,3 (1PE23.6, 3X) ) CGG 
295 CONTINUE CGG 
CALL  RMATIN(NM,N,A,B,AHOLD, BHOLD, 1) CGG 

CALL  RMATIN(NM,N,AI,BI,AHOLDI, BHOLDI,1) CGG 

CALL  RMATIN(NM,N, AHOLD, AHOLDI,Z,ZI,1) CGG 

CALL CGGWZR(NM,N,A,AI,B,BI,ALFR,ALFI,BETA,AHOLD,AHOLDI, CGG 

$ NORM, RESDUL) CGG 
WRITE(IWRITE, 300) CGG 

300 FORMAT(/14X,35HCOMPUTED EIGENVALUE AND EIGENVECTOR, 20X, 8HRESIDUAL)CGG 
: CGG 
po 510 K=1, N CGG 
BETA(K) = AMAX1 (BETA(K),1.0E-50) CGG 

ALFR(K) = ALFR(K) / BETA(K) CGG 

ALFI(K) = ALFI(K) / BETA(K) CGG 

CGG 

ONE ELGENVECTOR. CGG 

CGG 

340 WRITE (IWRITE, 350) CGG 
$ K, ALFR(K) , ALFI(K) ,NORM(K), (Z(1,K), CGG 

$ ZI(1,K),1=1,N) CGG 
350 FORMAT (/12,1P2E23.6,E29.2/(5X,2E23.6)) CGG 
510 CONTINUE CGG 
GO TO 10 CGG 
END CGG 
SUBROUTINE RMATIN(NM,N,A,B,AHOLD, BHOLD, INITIL) CGG 
CGG 

THIS INPUT SUBROUTINE READS TWO REAL MATRICES A AND B_ FROM CGG 
SYSIN OF ORDER N. CGG 

TO GENERATE THE MATRICES INITIALLY, INITIL IS TO BE O. CGG 

TO REGENERATE THE MATRICES FOR THE PURPOSE OF THE RESIDUAL CGG 
CALCULATION, INITIL IS TO BE l. CGG 
CGG 

THIS ROUTINE IS CATALOGUED AS EISPDRV4(RSGREADI). CGG 
CGG 

REAL A(NM,NM),B(NM,NM) , AHOLD (NM, NM) , BHOLD (NM, NM) CGG 
REAL FLOAT CGG 
INTEGER IA( 20), IB( 20) CGG 
DATA IREADA/1/, IREADB/2/, IWRITE/6/ CGG 
CGG 

IF( INITIL .EQ. 1 ) GO TO 30 CGG 
READ (LREADA, 5) CGG 

S$ N, M CGG 

5 FORMAT(16, 6X, 16) CGG 
IF( N .EQ. 0 ) GOTO 70 CGG 

IF (M .NE. 1) GO TO 16 CGG 

pO 10 I =1,N CGG 
READ (IREADA, 17) CGG 

$ (IA(J), J=sI,N) CGG 
po 9 J=I,N CGG 
A(1,J) = FLOAT(IA(J)) CGG 

9 A(J,I) = A(I,J) CGG 
10 CONTINUE CGG 
11 READ(IREADB, 5) CGG 
$ N,M CGG 
IF( M .NE. l ) GO TO 20 CGG 

pO 15 1 =1,N CGG 
READ (IREADB, 17) CGG 

$ (IB(J), J=I,N) CGG 
DO 14 J = I,N CGG 

B(1I, J)=FLOAT(IB(J)) CGG 

14 B(J,1I)=B(1I,J) CGG 
15 CONTINUE CGG 
GO TO 22 CGG 

16 DO 18 1 =1,N CGG 
READ (LREADA, 17) CGG 
(IA(J), J=al,N) CGG 

17 FORMAT (6112) CGG 
pO 18 J =1,N CGG 

18 A(I,J) = FLOAT(IA(J)) CGG 
GO TO ll CGG 

20 DO 25 I = 1,N CGG 
READ (IREADB, 17) CGG 

$ (IB(J) ,J=#1,N) CGG 
DO 25 J = 1,N CGG 

25 B(I,J) = FLOAT(IB(J)) CGG 
22 DO 23 I #1,N CGG 
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aaa 
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23 


30 


40 


70 
80 


DO 23 J=1,N GGG 
BHOLD(1,J) = B(I,J) CGG 
AHOLD(I,J) = A(I,J) CGG 

RETURN CGG 
po 40 I #=1,N CGG 
po 40 J=#1,N CGG 
B(1,J) = BHOLD(I,J) CGG 
A(I,J) = AHOLD(I,J) CGG 
RETURN CGG 
WRITE (IWRITE, 80) CGG 
FORMAT (47HOEND OF DATA FOR SUBROUTINE RMATIN(RSGREADI). /1H1) CGG 
STOP CGG 
END CGG 
CGG 

Se Se bien a bien cele eet eke co cee we canes cee ent aedewseaeece se CGG 
CGG 

SUBROUTINE CGGWZR(NM,N,A,AI,B,BI,ALFR,ALF1,BETA,Z,Z1,NORM,RESDUL) CGG 
CGG 

REAL NORM(N), ALFR(N), ALFI(N), BETA(N), CPART(2), A(NM,N), CGG 
$ B(NM,N), Z(NM,N), XR, XI, S, SUMZ, SUMR, SUMI, CGé 
$ RESDUL , NORMAB, SUMA, SUMB, NORMA, NORMB, CGG 
$ SUMR2,SUMI2,SUMR3,SUMI3, AI(NM,N) ,BI(NM,N) ,ZI(NM,N) CGG 
REAL CABS,ABS, FLOAT, AMAX1 CGG 
COMPLEX C, Cl CGG 
COMPLEX CMPLX CGG 
EQUIVALENCE(C1, CPART(1)) CGG 
CGG 

THIS SUBROUTINE FORMS THE 1-NORM OF THE RESIDUAL MATRIX CGG 
A*Z-B*Z*DIAG(W) WHERE A AND B ARE COMPLEX GENERAL MATRICES, Z IS CGG 
A MATRIX WHICH CONTAINS THE EIGENVECTORS OF THE EIGENPROBLEM CGG 


A*Z - B*Z*DIAG(W), AND W STANDS FOR A VECTOR OF CORRESPONDING CGG 


EIGENVALUES OF THE EIGENPROBLEM OBTAINED FROM THE VECTORS ALFR, CGG 
ALFI, AND BETA BY THE CORRESPONDENCES CGG 
W(J) = (ALFR(J) + I*ALFI(J)) / BETA(J) . CGG 

ALL NORMS APPEARING IN THE COMMENTS BELOW ARE 1-NORMS. CGG 
CGG 

INPUT- CGG 
CGG 

NM IS THE ROW DIMENSION OF TWO-DIMENSIONAL ARRAY PARAMETERS CGG 

AS DECLARED IN THE CALLING PROGRAM DIMENSION STATEMENT, CGG 

CGG 

N IS THE ORDER OF THE MATRICES A AND 8B, CGG 
CGG 

A(NM,N),AI(NM,N),B(NM,N), AND BI(NM,N) ARE ARRAYS WHICH CGG 
CONTAIN THE MATRICES OF THE SYSTEM, CGG 

CGG 

Z(NM,N) AND ZI(NM,N) ARE ARRAYS WHICH CONTAIN THE CGG 
EIGENVECTORS OF THE SYSTEM, CGG 

CGG 

ALFR(N), ALFI(N), AND BETA(N) ARE ARRAYS CONTAINING THE CGG 
COMPONENTS OF THE EIGENVALUES OF THE SYSTEM. CGG 

CGG 

OUTPUT- CGG 
CGG 


Z(NM,N) AND ZI(NM,N) ARE ARRAYS WHICH CONTAIN THE NORMALIZED CGG 
APPROXIMATE EIGENVECTORS OF THE SYSTEM. THE EIGENVECTORS CGG 


ARE NORMALIZED USING THE 1-NORM IN SUCH A WAY THAT THE FIRSTCGG 
ELEMENT WHOSE MAGNITUDE IS LARGER THAN THE NORM OF THE CGG 
EIGENVECTOR DIVIDED BY N IS REAL AND POSITIVE, CGG 

CGG 

NORM(N) IS AN ARRAY SUCH THAT FOR EACH K, CGG 
CGG 

. »-BETA(K) *A*Z (K) -ALFA*B*Z(K).. CGG 

NORM(K) 8-9-9 one nnn rn nnn nnn enn crn nrcnn CGG 

.- Z(K)..*(BETA(K)*..A..+.ALFA(K).*..B..) CGG 

CGG 

WHERE Z(K) IS THE K~-TH EIGENVECTOR AND ALFA = (ALFR + I*ALFI),CGG 

CGG 

RESDUL IS THE REAL NUMBER CGG 

. « BETA*A*Z-ALFA*B*Z../(..2..*(BETA*..A..+.ALFA.*..B..)) CGG 

CGG 

rrr errr CGG 
CGG 

NORMB = 0.0 CGG 
NORMA = 0.0 CGG 


RESDUL = 0.0 CGG 
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Cc 


10 


20 


100 


DO 20 I = 1,N 

SUMA = 0.0 

SUMB = 0.0 

bDO 10 L = 1,N 
SUMA = SUMA + ABS(A(L,I)) + ABS(AI(L,I)) 
SUMB = SUMB + ABS(B(L,I)) + PER IAG: I)) 

NORMA = AMAX1 (NORMA, SUMA) 

NORMB = AMAX1 (NORMB,SUMB) 


DO 160 I=1,N 

S = 0.0 

SUMZ = 0.0 

bo 110 L#=1,N 
SUMR = 0.0 
SUMI = 0.0 
SUMR2 = 0.0 
SUMI2 = 0.0 
SUMZ = SUMZ + CABS(CMPLX(Z(L,1I),ZI(L,I))) 


DO 100 K=#1,N 
SUMR = SUMR + B(L,K)*Z(K,1) - BI(L,K)*ZI(K,I) 
SUMI = SUMI + B(L,K)*Z1(K,1) + BI(L,K)*Z(K,I) 
SUMR2 = SUMR2 + A(L,K)*Z(K,1) - AI(L,K)*ZI(K,1) 
SUML2 = SUMI2 + A(L,K)*Z1I(K,I) + AI(L,K)*Z(K,I) 

SUMR3 = -ALFR(I)*SUMR + ALFI(1I)*SUMI 

SUMI3 = -ALFI(1)*SUMR -: ALFR(1)*SUMI 


S = S+CABS(CMPLX (SUMR3 , SUMI3) +CMPLX(SUMR2 ,SUMI2) *BETA (I) ) 
NORMAB = NORMA*BETA(I)+NORMB*CABS (CMPLX (ALFR(I) ,ALFI(1) )) 
IF( NORMAB .EQ. 0.0 ) NORMAB = 1.0 


NORM(I) = SUMZ 
IF( SUMZ .EQ. 0.0 ) GO TO 150 
AAKKKKKAKKTHTS LOOP WILL NEVER BE COMPLETED SINCE THERE WILL 
ALWAYS EXIST AN ELEMENT IN THE VECTOR (2(1),2Z1(1)) 
LARGER THAN ..(Z(1),Z1(1).. /NXXARRARKA 
DO 120 L=1,N 
LF (CABS (CMPLX(Z(L,1I),ZI(L,1))) .GE. NORM(1)/FLOAT(N)) 
GO TO 130 
CONTINUE 


XR = NORM(I)*2(L,I) /CABS(CMPLX(Z(L,1),ZI(L,1))) 
XL = NORM(I)*ZI(L,I) /CABS(CMPLX(Z(L,I),Z1(L,I))) 
C = CMPLX(XR,X1) 


DO 140 L= 1,N 
Cl = CMPLX(Z(L,I),ZI(L,I))/C 
Z(L,1) = CPART(1) 

Z1(L,1I) = CPART(2) 


NORM(1) = S/(NORM(1L)*NORMAB) 
RESDUL = AMAX1 (NORM(1) ,RESDUL) 


CONTINUE 
RETURN 
END 
~238 86 164 -166 56 
76 ~96 40 60 -60 
118 55 -13 34 -176 
-314 132 114: -90 ~424 
-54 -205 109 158 -38 
-344 178 240 -308 158 
152 -128 32 184 -136 
284 -182 460: -192 -214 
-160 78 296 -164 -374 
~24 -400 148 312 -96 
41 -143 -20 20 104 
148 144 -6 -78 8 
-19 87 4 -56 -164 
-60 -81 99 34 84 
1 133 132 -46 -12 


CGG 2040 
CGG 2050 
CGG 2060 
CGG 2070 
CGG 2080 
CGG 2090 
CGG 2100 
CGG 2110 
CGG 2120 
CGG 2130 
CGG 2140 
CGG 2150 
CGG 2160 
CGG 2170 
CGG 2180 
CGG 2190 
CGG 2200 
CGG 2210 
CGG 2220 
CGG 2230 
CGG 2240 
CGG 2250 
CGG 2260 
CGG 2270 
CGG 2280 
CGG 2290 
CGG 2300 
CGG 2310 
CGG 2320 
CGG 2330 
CGG 2340 
CGG 2350 
CGG 2360 
CGG 2370 
CGG 2380 
CGG 2390 
CGG 2400 
CGG 2410 
CGG 2420 
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-369 -747 -1368 486 -432 DATAL 20 
261 666 -1152 45 ~540 DATAI 21 

819 243 1548 -954 180 DATAL 22 
-945 -279 171 441 -144 DATAL 23 
-468 747 774 -45 -216 DATA! 24 

5 DATAL 25 
-15 -143 -83 41 55 DATA1 26 

100 144 -60 -60 ~34 DATA1L 27 

-19 87 4 -56 -164 DATAL 28 
-116 -81 36 55 35 DATAI 29 
~39 133 87 -31 -47 DATA] 30 

5 DATAI 31 
-1635 -173 -1142 1012 -566 DATA 32 
-829 1128 -1050 495 -710 DATA] 33 
971 187 1558 -1016 218 DATA1 34 
562 -944 -1310 238 -937 DATA] 35 
356 ~149 -875 -434 -1015 DATA 36 

0 DATAL 37 
5 DATA2 1 
388 -386 -250 556 -396 DATA2 2 
-304 384 -160 -240 240 DATA2 3 
-658 -73 -109 -118 406 DATA2 4 
-640 204 ~692 288 -192 DATA2 5 
-162 631 131 -758 278 DATA2 6 

5 DATA2 7 
94 -122 -14 130 -62 DATA2 8 

-76 64 16 -92 68 DATA2 9 
-136 100 -250 100 96 DATA2 10 
-10 -42 -90 66 154 DATA2 11 

-72 158 52 -184 76 DATA2 12 

5 DATA2 13 
90 180 36 -90 -72 DATA2 14 

-105 -210 -42 105 84 DATA2 15 
-90 -180 -36 90 72 DATA2 16 

75 150 30 -75 -60 DATA2 17 

-75 -150 ~30 75 60 DATA2 18 

5 DATA2 19 
161 335 182 -162 -36 DATA2 20 
-169 -322 24 167 204 DATA2 21 
~211 -307 -160 186 36 DATA2 22 
205 215 45 -165 -80 DATA2 23 

-48 -299 -102 89 88 DATA2 24 

5 DATA2 25 
90 180 36 -90 -72 DATA2 26 

-105 -210 -42 105 84 DATA2 27 
-90 -180 -36 90 72 DATA2 28 

75 150 30 -75 -60 DATA2 29 

-75 -150 -30 75 60 DATA2 30 

5 DATA2 31 
307 253 163 -235 -39 DATA2 32 

-49 -410 46 85 182 DATA2 33 
-229 -253 -200 234 84 DATA2 34 
171 301 184 -130 25 DATA2 35 
-134 -185 59 146 195 DATA2 36 
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Remark on Algorithm 535 


The QZ Algorithm to Solve the Generalized Eigenvalue Problem [B.S. Garbow, 
ACM Trans. Math. Softw. 4, 4 (Dec. 1978), 404-410] 


B.S. Garbow [Received 10 June 1982; accepted 10 June 1982] 


Applied Mathematics Division, Argonne National Laboratory, 9700 S. Cass 
Avenue, Argonne, IL 60439. 


Replace the single card with sequence label VAL 153: 

IF (BI (L, L) .EQ. 0.0) GO TO 98 

with 

IF (B11 .EQ. 0.0) GO TO 98 

The error that this change corrects results occasionally in eigenvalues with the 
wrong sign. 


COLLECTED ALGORITHMS FROM ACM 


536-P 1-0 


ALGORITHM 536 
An Efficient One-Way Enciphering 
Algorithm [Z] 


H. D. KNOBLE 
The Pennsylvania State University 


Key Words and Phrases: one-way security transformation, password, encipher, decipher, 
multiprecision integer arithmetic 

CR Categories: 3.15, 4.49 

Language: Fortran 


DESCRIPTION 


This algorithm is a Fortran implementation of the procedures developed in [1]. 
Its purpose is to serve as a machine independent model for studying the evaluation 
of polynomials mod P and for the implementation of more efficient machine 
dependent system utility programs for enciphering passwords. 


REFERENCES 
1. KNoBLE, H.D., Forney, C., AND BADER, F.S. An efficient one-way enciphering algorithm. ACM 
Trans. Math. Software 5, 1 (March 1979), 97-107. 


ALGORITHM 

C-—~~--— SAMPLE PROGRAM TO ENCIPHER 72-BIT PASSWORDS ACROSS 66000010 
C MACHINES WITH 3 DIFFERENT WORD SIZES. OUTPUT IS TABLE 2A OR 2B. 00000020 
C -TO RUN THIS PROGRAM COMMENTS BEGINNING C32, C36, OR C60 MUST BE 00069030 
C ACTIVATED BY REPLACING THESE FIRST THREE CHARACTERS WITH BLANKS. Y0OOYOLO 
C TABLE 2A WILL BE PRODUCED ON IBM 360/370 OR XEROX SIGMA SERIES 00000050 
C  32-BIT MACHINES BY ACTIVATING COMMENTS BEGINNING WITH C32. IOOIODED 
C TABLE 2B WILL BE PRODUCED ON UNIVAC 1100, HONEYWELL 600/4000, AND 90008070 
C DEC SYSTEM 10/20 36-BIT MACHINES WHEN ACTIVATING COMMENTS BEGINNING Y00ddoR9 
C WITH C36. TABLE 2B WILL BE PRODUCED ON THE CDC 6600/7600 6¢-BIT 60000090 
C MACHINES WHEN ACTIVATING COMMENTS BEGINNING WITH C6. 00000100 
C 004000110 
C INPUT TO THIS PROGRAM ARE THE FOLLOWING 10 CARDS BEGINNING WITH C= 00000120 
C= HEX (G9000000CH00OOEGO) OCTAL(900000000G00063000000000) DECIMAL(O) 00000130 


C= HEX (060000006600000001) OCTAL(O038008000060000000000001) DECIMAL(1) 06000149 
C= HEX ($00000090000000002) CCTAL (9CCO0O000090060000600002) DECIMAL(2) SOOOO1LSO 
C= HEX (09000000000000003) OCTAL (9003O0000005C0006000603) DECIMAL(3) DCOOPLED 
Cu HEX(FFFFFFFFFFFEFFSSA3) OCTAL(777777777777777777777643) DECIMAL(P) 4060170 
C= HEX(FFFFFFFFFFZFFFFFA4) CCTAL(777777777777777777777644) DECEMAL(P+1) O¢606180 
C= HEX(FFFFFFFFFFFFFFFFAS) OCTAL(777777777777777777777645) DECIMAL(P+2) $06¢0199 
C= HEX (96600600066000055C) OCTAL(0906006600400000000000134) DECIMAL(92) addrn20n 
C= HEX(FFFFFFFFFFFFFFFSFS) OCTAL(777777777777777777777777) DECIMAL (P+92)0009021¢ 
C= HEX(555555555555555555) OCTAL(252525252525252525252525) BINARY (@L...) 00000220 


Received January 1976; revised September 1977. 
Permission to copy without fee all or part of this material is granted provided that the copies are not 


made or distributed for direct commercial advantage, the ACM copyright notice and the title of the 
publication and its date appear, and notice is given that copying is by permission of the Association 
for Computing Machinery. To copy otherwise, or to republish, requires a fee and/or specific 
permission. 

Author’s address: Computation Center, The Pennsylvania State University, Computer Building, 
University Park, PA 16802. 
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¢ 00000230 
om SS er oa amen neo ne = =~ 0000248 
INTEGER A,NN,N(6) 006000250 

C32 INTEGER X(3),FX(3),2?(3),AC(3,6) ,WORK(43) ,NP,IW 60000260 
C36 «INTEGER X(2),FX(2),P(2) ,AC(2,6) ,WORK(31) ,NP,IW 09000270 
C66 INTEGER X(2),FX(2),P(2),AC(2,6) ,WORK(31) ,NP,IW 006066280 
C---—~~ A IS CHOSEN TO MAKE P=2**72-A A PRIME INTEGER IN THE 60000290 
c INTERVAL (2**(NP*M)-—2**(M-1), 2**(NP*M)). NP*M=72 HERE. 06900300 
DATA A/93/, NN/6/ 60660310 

DATA N(1)/1048569/,N(2)/524285/,N(3)/3/,N(4)/2/,N(5)/1/,N(6)/9/ 00600320 
C.32.....IBM, XEROX 32-3IT MACHINES, HEXADECIMAL CONSTANTS (Z). 906000330 
C32.) -~ DATA NP/3/, IW/43/ 00000340 
C32 DATA AC(1,1),AC(2, 2) ,AC(3,1) /ZEC0C90006 , 260000000, Z60008001/, 006600350 
C32 «* AC(1,2),AC(2, 2) ,AC(3, 2) /ZOOFFFIFF, ZOOFFIFFF,cOOFFFFAL/, 006006360 
C32 * AC (1,3) ,AC(2, 3) ,AC(3, 3) /ZOOFFFFEF, ZOOFFFFFF, ZCOFFFF83/, 606¢0376 
G32. -2 AC(1,4),AC(2,4) ,AC(3,4) /ZOOFFFFFF, ZGOFFFFFF,200FFTF73/, 4OOCO 380 
C32. «* AC(1,5),AC(2,5),AC (3,5) /ZOOFFFFFF,ZO9FFFErF,ZOOFFFF9E/, 00600390 
C32 * AC(1,6) ,AC(2,6),AC(3,6)/ZOOFFFFFE , Z0OFFFFFF , Z0OFFFFO2/ 90600400 
c 00000416 
C.26.ee5e-UNIVAC, HONEYWELL, DEC 36-BIT MACHINES, OCTAL CONSTANTS(O). 60000426 
C36 DATA NP/2/, IW/31/ 90900436 
C36 = dDATA:~«AC(1,1) ,AC(2, 1) /060GOAG9GOACS, OCGDONAAGCOO1/, DOOGOLLA 
C36 ® AC(1, 2) ,AC(2, 2) /0777777777777,0777777777641/, 06600450 
C36 * AC(1, 3) ,AC(2, 3) /0777777777777,0777777777603/, 10000460 
C36 * AC(1, 4) ,AC(2, 4) /C777777777777,0777777777573/, $0000470 
C36 * AC(1,5),AC(2,5)/0777777777777,0777777777636/, IOOOHL3O 
C36 *® AC(1,6) ,AC(2, 6) /0777777777777,0777777777402/ 000066490 
C 660006520 
C.60......CDC 6606/7600 60-BIT +, 48-BIT */, OCTAL CONSTANTS (B). 90000510 
C66 DATA NP/2/, IW/31/ 60000526 
C6@ =DATA AC(1, 1) ,AC(2, 1) /0060000000006000000OB , 000000000000000000018/ , 60000530 
C66 * AC (1,2) ,AC(2, 2) /©0000000777777777777B , 00000000777777777641B/ ,00000540 
c6o * AC(1, 3) ,AC(2, 3) /000000007777777777778B ,90000000777777777603B/ ,00000550 
C60 * AC(1, 4) ,AC(2, 4) /00000000777777777777B ,0000000077777777757338/ , 00000560 
C66 * AC(1,5) ,AC(2, 5) /606000007777777777773 ,00000000777777777636B/ ,60000570 
C66 * AC(1,6) ,AC(2, 6) /00080000777777777777B ,60000000777777777402B/ 60000580 
Cc 000600596 
WRITE (6,1) O06000606 

C32 1 FORMAT(45H1HEXADECIMAL INPUT(X) HEXADECIMAL OUTPUT(FX)/1X) 00000616 
C36 1 FORMAT(L5SHIOCTAL INPUT(X),14X,16HOCTAL OUTPUT(FX)/1X) 20000620 
C60 1 FORMAT(15HIOCTAL INPUT(X),14X,16HOCTAL OUTPUT (FX) /1X) 000066 30 
C-~-—--~-——-INPUT AND ENCIPHER 16 BIT STRINGS. 00000646 
DO 4 I=1,1¢ 06000656 
READ(5,2) X 80000660 

C32 2 FORMAT (7X, 326) 09000670 
C36 2 FORMAT (33X, 2012) 10000680 
C6@ 2 FORMAT (33X, 2012) 00000690 
CALL PURDY(X,FX,A,P,N,AC, WORK,NP,NN, IW, NP, LERR) 90080700 
IF(IERR.NE.@) GO TO 5 106009716 

WRITE (6,3) X,FX 00600720 

C32 3 FORMAT (1X, 326, 4X, 326) 00000730 
C36 3 FORMAT (1X, 2012, 4X, 2012) 00060740 
C60 3 FORMAT (1X, 2012, 4X, 2012) 10000750 
4 CONTINUE 00006760 
STOP 00000776 

5 WRITE(6,6) IERR 00000780 

6 FORMAT (46HO****ERROR RETURN FROM SUBROUTINE PURDY. IERR=,12) 90000790 
STOP 66000860 

END 00000810 
BLOCK DATA 90000820 
COMMON/MACHIN/ ISIZE,M,MAXPOS ,MINNEG,MASK 00000830 

C32 DATA ISIZE/32/,M/24/,MAXPOS/Z2007FFFFEF/ , MINNEG/Z06800000/, 60000840 
C32 MASK/201000000/ 000060850 
C36 DATA ISIZE/36/,M/36/,MAXPOS/0377777777777/ , MINNEG/0400006000000/, 90000860 
C36 * MASK/6/ $0006870 
C60 DATA ISIZE/60/,M/36/,MAXP0S/9$606600377777777777B/, 06000886 
C66 * MINNEG/$0006000400000000000B/ , MASK/60O00001.0600000066000B/ 0000890 
END 10000900 
SUBROUTINE PURDY(X,FX,A,PRIME,N,ACOEFF,WORK,NP,NN,NW,IDIMA,IERR) 60000016 

C =======ROUTINE TO EVALUATE PURDY'S IRREVERSIBLE ENCI2HERING FUNCTION. ..0000002¢ 
Cc FX=F(X)=P(X) MOD PRIME WHERE 990600030 
C  P(X)= SUM(ACOEFF(I)*X**N(I)), I=1,2,3,...,NN. 00900040 
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DAANAADAAAARDAANRNDAAAANAIADAIAAAAAAIAADAAMAANANMNAAAANAANANAANAANAANAAANDANNANADAAAAANAANDAANQANAAANAANAAMAAANANAAAANAAAAA 


THAT IS, THIS ROUTINE EVALUATES SPARSE POLYNOMIALS OF VERY LARGE 96600050 
DEGREE MODULO A PRIME. SUCH FAMILIES OF ENCIPHERING FUNCTIONS AND 600606060 
RELATED PROPERTIES ARE DISCUSSED IN... 0000070 
A HIGH SECURITY LOG-IN PROCEDURE, BY GEORGE B. PURDY, AUGUST 1974, 60606060080 
CACM 17(8), PAGES 442-444, 09000090 
90900100 

00600116 

PARAMETERS... 000600120 
THE LABELED COMMON/MACHIN/ DESCRIBES PARAMETERS RELATING TO THE 690060130 
HOST MACHINE'S WORD SIZE AND MUST BE INITIALIZED TO THE FOLLOWINGG00060140 
VALUES BEFORE SUBROUTINE PURDY IS CALLED... 00000156 
000900160 

ISIZE IS GIVEN AS THE TOTAL NUMBER OF BITS IN AN INTEGER COMPUTER 0060600170 
WORD. 06606186 
90600190 

M IS GIVEN AS AN EVEN INTEGER WHOSE VALUE IS THE NUMBER OF 09006200 
SIGNIFICANT (LOW-ORDER) BITS IN EACH COMPUTER WORD TO BE 09000210 

USED TO REPRESENT A MULTIPRECISION INTEGER. +,-,/,* MUST BEG@OG60622¢ 

VALID OVER THE NORMAL RANGES FOR INTEGER ARITHMETIC. 00006236 

THAT IS, INTEGER ARITHMETIC MUST BE VALID OVER 99600240 
—2**(M-1)-1 .LE. R «LE, 2**(M-1)-1 FOR 1'S COMPLEMENT, 00000256 

AND SIGNED MAGNITUDE MACHINES AND VALID OVER THE RANGE 000600260 
-2**(M-1) .LE. R .LE. 2**(M-1)-1 FOR 2'S COMPLEMENT MACHINESO606002706 

WHERE R IS ANY COMPUTED RESULT. FOR SIGNED MAGNITUDE 64090280 
MACHINES M MUST BE EVEN AND NO GREATER THAN ISIZE-2. 906900290 
OTHERWISE M MUST BE EVEN AND LESS THAN OR EQUAL TO ISIZE. 660603060 
66000310 

MAXPOS IS GIVEN AS THE BIT STRING VALUE OF 2**(M-1)-1, THAT IS THE 000606032 
BIT STRING @111...111 . 00000330 
00000340 

MINNEG IS GIVEN AS THE BIT STRING VALUE OF 2**(M-1), THAT IS THE  00600035¢ 
BIT STRING 1000...000. 960600360 
090600376 

MASK IS GIVEN AS THE BIT STRING VALUE OF 2**M MOD 2**ISIZE. THE 440006380 
HOST COMPUTER MUST SUPPORT INTEGER ADDITION AND SUBTRACTION 900000390 

WITH THE VALUE OF MASK AND ALL INTEGERS IN THE RANGE 0OO0G400 
DESCRIBED FOR M ABOVE. 06000416 
00600426 

DEFINITION: A NP WORD MULTIPRECISION INTEGER IS AN UNSIGNED (NP*M)- 600006430 
BIT NUMBER STORED IN NP SUCCESSIVE INTEGER COMPUTER 00000446 

WORDS, THE HIGHEST ORDER PART BEGINNING WITH THE FIRST 66000450 

WORD, THE LOWEST ORDER ENDING IN THE LAST. THAT IS, 69000460 

EACH ELEMENT OF THE ARRAY REPRESENTING A MULTIPRECISION 66600476 

INTEGER IS TREATED AS A BASE-.2**M DIGIT WITH ISIZE-M 09000480 

LEADING ZERO BITS. NORMALLY ISIZE=M OR M IS CHOSEN SUCH 6066060490 

THAT ISIZE-M IS AN EXACT MULTIPLE OF THE NUMBER OF BITS 660005060 

USED TO REPRESENT A CHARACTER. FOLLOWING PURDY'S 60600516 

NOTATION, IN FURTHER DISCUSSIONS HERE Q, THE PASSWORD AOOHD5 20 

LENGTH, WILL BE ASSUMED TO BE Q=NP*M. 00600530 

00090546 

00000556 

x IS GIVEN AS AN UNSIGNED NP-WORD MULTIPRECISION INTEGER 00900560 
REPRESENTING A STRING OF Q BITS TO BE ENCIPHERED. 09000576 

X NORMALLY REPRESENTS A CHARACTER STRING (PASSWORD). 0606006580 
000060590 

FX IS RETURNED AS AN UNSIGNED NP-WORD MULTIPRECISION INTEGER 90000600 
WHOSE Q-BIT VALUE IS THE VALUE OF THE ENCIPHERING 00000616 
FUNCTION, F(X), ABOVE. 09000620 
90000636 

A IS GIVEN AS A POSITIVE INTEGER .LE. MAXPOS WHOSE VALUE IS THEG$O60640 
PRIME OFFSET CONSTANT DESCRIBED IN.THE ABOVE REFERENCE. THATO@¢0065¢ 

IS, A MUST BE CHOSEN TO FORCE THE VARIABLE PRIME TO BE PRIME 0060600660 

WHERE PRIME IS DEFINED AS PRIME=2**(M*4NP) - A. SOME VALUES 660006670 

ARE TABULATED IN KNUTH, ART OF COMPUTER PROGRAMMING, VOL. 2, 96660680 

TABLE 4.5.4-1. NO CHECK IS MADE BY THE PROGRAM TO INSURE 000900699 

THIS PRIMALITY CONDITION AS IT ONLY AFFECTS THE KNOWN 00000700 
DEGENERACY OF THE ENCIPHERING FUNCTION, F. 900600710 
90000726 

PRIME IS RETURNED AS AN UNSIGNED NP-WORD MULTIPRECISION INTEGER 000060730 
WHOSE Q-BIT VALUE IS THE VALUE OF 2%**(NP*M)-A. 90000740 
90000750 

N IS GIVEN AS AN INTEGER ARRAY OF LENGTH NN WHOSE ELEMENTS ARE 60600606760 
THE EXPONENTS OF X. THE ELEMENTS OF N MUST BE NON-NEGATIVE. 60600067706 
TYPICALLY, AS SUGGESTED BY PURDY, THE FIRST ONE OR TWO 00000786 
ELEMENTS OF N ARE VERY LARGE NON-PRIME INTEGERS, SAY 000006790 
GREATER THAN 1@*%*5. 006060606800 
$0600810 
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c  ACOEFF IS GIVEN AS AN IDIMA BY NN ARRAY REPRESENTING THE UNSIGNED 460600820 
C MULTIPRECISION INTEGER COEFFICIENTS OF THE ENCIPHERING 060900836 
c POLYNOMIAL F(X) ABOVE. THESE COEFFICIENTS SHOULD BE 909000840 
Cc CHOSEN TO HAVE (LARGE) VALUES, LESS THAN 2**Q-A. THE 00000850 
C PRECISION OF THE ELEMENTS OF ACOEFF IS NP AND THEREFORE 09600860 
C IDIMA USUALLY WOULD BE CHOSEN SUCH THAT IDIMA=NP. 06000870 
c $0000880 
C WORK IS GIVEN AS AN WORKSPACE ARRAY OF NW=12*NP+7 INTEGER WORDS. 00600896 
C 00000900 
Cc NP IS GIVEN AS AN INTEGER WHOSE VALUE IS THE PRECISION OF 90006910 
Cc MULTIPRECISION INTEGERS. THAT IS, NP IS THE NUMBER OF 09060926 
Cc INTEGER COMPUTER WORDS NECESSARY TO STORE THE UNSIGNED 09000930 
C MULTIPRECISION INTEGER 2**Q—1. NP MUST BE GREATER THAN 1. 600600940 
C 06006950 
Cc NN IS GIVEN AS AN INTEGER WHOSE VALUE IS THE NUMBER OF TERMS IN $00906960 
Cc P(X) ABOVE. NN MUST BE GREATER THAN @. 00000976 
C 90600980 
C NW IS GIVEN AS AN INTEGER WHOSE VALUE IS GREATER THAN OR EQUAL 66000990 
Cc TO 12*NP+7. NW IS THE DIMENSION OF THE WORKSPACE ARRAY, WORK.000010600 
C 000010610 
C IDIMA IS GIVEN AS AN INTEGER WHOSE VALUE IS EQUAL TO THE 09001620 
c FIRST DIMENSION CONSTANT OF THE ARGUMENT IN THE CALLING $0001430 
Cc PROGRAM CORRESPONDING TO THE PARAMETER, ACOEFF. NORMALLY 000601040 
C IDIMA=NP. 96001050 
C 09001060 
C IERR IS RETURNED AS AN ERROR INDICATOR AS FOLLOWS... $00010670 
Cc IERR=1 IF NP .LE. 1 OR NN IS NOT POSITIVE, IF NW IS LESS THAN 12*NP+7060601680 
C OR IF ANY OF THE NN ELEMENTS OF N ARE NEGATIVE. 00901690 
C  IERR=2 IF A IS NOT IN ITS RANGE DESCRIBED ABOVE. 06001100 
Cc LERR=3 IF M IS UNEVEN OR GREATER THAN ISIZE OR IF THE HOST MACHINE 600011106 
C PERFORMS SIGNED MAGNITUDE ARITHMETIC AND M IS UNEVEN OR 60001120 
Cc GREATER THAN ISIZE-2. 069001130 
C  IERR=4 IF THE LEADING ISIZE-M BITS OF ANY ELEMENT OF X ARE NOT ZERO. 600061140 
C  IERR=6$ OTHERWISE. FX AND PRIME ARE RETURNED UNCHANGED IF IERR 00001156 
Cc IS RETURNED NON-ZERO. $0001160 
Cc 00001176 
C NOTES: THIS ALGORITHM IS PRESENTED HERE AS A GENERAI, EVALUATION $906¢6118¢ 
Cc SCHEME AND THE FORTRAN CODE IS INTENDED TO SERVE AS A MODEL $40606119¢ 
Cc FOR CONSTRUCTING A SIMILAR SYSTEM UTILITY FUNCTION. 060012060 
C TO PROGRAM AN EFFICIENT RE-ENTERABLE ASSEMBLER VERSION OF 00001216 
C THIS ALGORITHM TO BE USED AS PART OF A SYSTEM PASSWORD 66001226 
Cc AUTHORIZATION SCHEME THE FOLLOWING IS RECOMMENDED... 90001230 
C 00061246 
Cc ---- CHOOSE M=ISIZE (EVEN FOR SIGNED MAGNITUDE MACHINES) AND 60001250 
C USE EQUIVALENT MACHINE INSTRUCTIONS IN PLACE OF SUBROUTINES 6006012606 
C LADD, LSUB, AND KOMP. ELIMINATE SUBROUTINES SPLIT, JOIN, 000061270 
C ISIGNM AND ALL REFERENCES TO COMMON BLOCK /MACHIN/. 90001280 
C IN SUBROUTINE MPMLT CUT THE PRECISION FROM 2*NP TO NP BY USINGGOOG129¢0 
C THE EQUIVALENT OF A LOGICAL MULTIPLY MACHINE INSTRUCTION. 006001300 
C 00001316 
Cc ---- CHOOSE A FAMILY OF ENCIPHERING POLYNOMIALS AND FACTOR IT 00001320 
a BEFORE EVALUATION. FOR EXAMPLE, IF N(1)=2*N(2)-1, N(3)=3, 90001330 
E N(4)=2, N(5)=1, N(6)=@, NN=6, THEN P(X) FACTORS TO... 00001346 
C X** (N(2)=-1) * (X* (X*4* (N(2)-1)+ACOEFF(1,1))) + 90001350 
C X* (ACOEFF (1, 4)+X* (ACOEFF (1, 3) +ACOEFF(1,2)*X)). 00001360 
Cc THIS REDUCES THE NUMBER OF CALLS TO EXPP THUS SHARPLY REDUCING#(001370 
C COMPUTING TIME. 000061380 
C 00001390 
C ---- WHEN PRECISION IS CONSTANT, WORKSPACE AND RELATED PARAMETERS 00001400 
C BECOME CONSTANTS AND THE PROGRAM IS CONSIDERABLY SIMPLIFIED. 40001410 
c ONCE THIS IS DONE PASS ALL WORKSPACE VARIABLES IN COMMON AND 40001426 
Cc REMOVE ALL DIMENSION PARAMETERS AND WORKSPACE PARAMETERS FROM $400143¢ 
C THE ARGUMENT/PARAMETER LISTS. THIS SUBSTANTIALLY REDUCES 00061446 
C LINKAGE TIME. 00001450 
Cc 00001460 
C WRITTEN BY H. D. KNOBLE, PENN STATE UNIVERSITY COMPUTATION CENTER, 60001470 
C JUNE 1977. 00001480 
CaeaasesSsiesatatarsssssse rss ss aas SS ssS Sessa ess ss Sess Sse sss assass======99991499 

INTEGER X(NP),FX(NP) ,Q,A,PRIME(NP) ,N(NN) ,ACOEFF(IDIMA,NN) , WORK (NW) 600015060 

COMMON/MACHIN/ISIZE,M,MAXPOS , MINNEG, MASK 69001510 
C~---------- CHECK PARAMETERS FOR DOMAIN ERRORS. 90001520 
IERR=0 90001530 

IF(NP.LE.1.OR.NN.LE.@) IERR=1 00001546 

IF(IDIMA.LT.NP.OR.NW.LT.12*NP+7) [ERR=1 $9001550 

IF(A.LE.@.OR.A.GT.MAXPOS) IERR=2 00001566 

DO 1 I=1,NN 00001570 

IF(N(1I).LT.@) IERR=1 00001586 
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1 CONTINUE 


C-----------— CHECK HOST MACHINE ASSUMPTIONS ASSUMING MINNEG IS CORRECT. 


LF ((MOD(M, 2) .NE.@) .OR. (M.GT.ISIZE).OR. 

*  (M.GT.ISIZE-2.AND.MINNEG.EQ.@)) IERR=3 
C---+-------- CHECK IF THE LEADING (ISIZE-M) BITS OF THE WORDS OF X 
Cc ARE NON-ZERO. 

IF(ISIZE.EQ.M) GO TO 3 
DO 2 I=1,NP 
IF(X(I).GE.MASK) IERR=4 
2 CONTINUE 
3 IF(IERR.NE.@) RETURN 
C----------- FOR Q=NP*M, COMPUTE P=2**Q-A. 
NP1=NP+1 
NP2=NP*2 
DO 4 I=1,NP2 
4 WORK(1)=@ 
WORK (NP2)=A 
CALL MPSUB (WORK, WORK (NP1) , PRIME,NP) 
C---------- INITIALIZE 
N2=NP2+1 
IWE=1@*NP+7 
IWM=8*NP+7 
IWA=34*NP+2 
Caepeesesee EVALUATE F(X) ONE TERM AT A TIME. 
DO 5 I=1,NN 
CALL EXPP(X,N(I) ,WORK(NP1) , PRIME ,WORK(N2) ,NP, IWE) 


CALL MULTP (ACOEFF(1,1),WORK(NP1L) ,WORK(NP1) ,PRIME,WORK(N2) ,NP, IWM) 


5 CALL ADDP (WORK ,WORK (NP1) ,WORK, PRIME, WORK (N2) ,NP, IWA) 
C-~------------ SET RESULT = F(X). FX AND X MAY BE SAME LOCATIONS. 
DO 6 I=1,NP 
6 FX (1)=WORK(I) 
RETURN 
END 


SUBROUTINE EXPP(X,K,Y,P,WORK,NP,NW) 

C ===COMPUTE Y=X**K MOD P FOR P=2**Q-A FOR UNSIGNED 
C MULTIPRECISION INTEGERS,X,Y,P OF PRECISION NP. 
C WORKSPACE ARRAY OF NW=NP*1@+7 WORDS. 
C 

Cc 


WORK IS A 
SEE KNUTH ALGORITHM 4.6.3-A. 


INTEGER X(NP),Y (NP) ,P(NP) , WORK (NW) 
NPP1=NP+1 
IWM=NP*8+7 
N= 
C--------- Y=1, Z=X. 


Y(1)=0 
1 WORK (I)=X (IL) 
Y(NP)=1 
C--------- X**9=1 FOR X .GE. @. 
IF(N.LT.1) RETURN 
2 L=N 
N=N/2 
IF(MOD(L, 2).EQ.@) GO TO 5 
CALL MULTP(Y,WORK,Y,P,WORK(NPP1) ,NP, IWM) 
IF(N.EQ.@) RETURN 
5 CALL, MOB UEGMORK MORK WORK) Es WOREANERL Sa vON 
T 


END 


SUBROUTINE MULTP(R,S,RS,P,WORK,NP,NW) 
C=========COMPUTE RS=R*S MOD P FOR P=2**Q-A FOR UNSIGNED 
C MULTIPRECISION INTEGERS R,S,RS,P OF PRECISION NP. WORK 
Cc IS A WORKSPACE ARRAY OF NW=NP*8+7 WORDS. 
INTEGER R(NP),S(NP),RS (NP) ,P (NP) ,WORK (NW) 
NP2=2*NP 
IW1=NP2+1 
IW2=IW1+NP 2 
IW3=IW2+NP2 
CALL MPMLT(R,S,WORK,WORK(IW1) , WORK (IW2) ,WORK(IW3) ,NP,NP, 
* NP2,NP2,NP2, 2*NP2) 
CALL MOD2Q(WORK,RS,P,WORK(IW1) ,NP2,NP,NP*6+7) 
RETURN 
END 


00001590 
00601600 
00601610 
06001620 
00001630 
006001640 
$000165¢ 
00001660 
00001676 
00001680 
00601690 
06001700 
0001710 
60001720 
069001730 
96001740 
09001750 
00001760 
66001776 
00601780 
00001790 
00601800 
90001819 
00001826 
06001830 
00601840 
$000185¢ 
00001860 
00001870 
00001886 
090018990 
00001900 
00601910 


06001926 
00001930 
00001946 
66001956 
00001960 
66001976 
00001980 
60001999 
AODO29GD 
BOOD2010 
60002020 
69002030 
$0G02040 
000620650 
00002660 
00002070 
00002080 
00002096 
$0002160 
00002116 
06002126 
000062130 
60002140 
00002150 
60002160 


80002170 
00002186 
00062190 
00002200 
00002210 
00002220 
000062230 
AOOO2 240 
609002250 
00002260 
90002276 
00062280 
00002299 
09002300 
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C 
6 
Cc AND R,P OF PRECISION NP. 
C 


ALGORITHMS (cont.) 


SUBROUTINE ADDP(R,S,RPS,P,WORK,NP,NW) 
=========COMPUTE RPS=R+S MOD P FOR P=2**Q—A FOR UNSIGNED 

MULTIPRECISION INTEGERS R,S,RPS,P OF PRECISION NP. 
WORK IS A WORKSPACE ARRAY OF NW=NP*3+2 WORDS. 

INTEGER R(NP),S(NP),RPS(NP) ,P(NP) , WORK (NW) 

NPP1=NP+1 

CALL MPADD(R,S,WORK,NP,NPP1) 

CALL MODQ1 (WORK, RPS,P,WORK(NPP1+1) ,NPP1,NP, 2*NP+1) 

RETURN 

END 


SUBROUTINE MOD2Q(W,R,P,WORK,NP2,NP,NW) 
=========CQMPUTE R=W MOD P FOR 2Q-BIT W, P=2**Q-A FOR UNSIGNED 
MULTIPRECISION INTEGERS W OF PRECISION NP2=NP*2, 
WORK IS A WORKSPACE ARRAY OF 
NW=NP*6+7 WORDS. 
INTEGER W(NP2),R(NP),P(NP) ,WORK(NW) ,U,A,JP 
COMMON /MACHIN/ISIZE,M,MAXPOS,MINNEG,MASK 
NPP1=NP+1 
NPM2=NPP1*2 
U=1 
JP=U+NPP1 
A=JP 
IWU=JP+NPP1 
IW1=IWU+1 
IW2=IW1+2 
IW3=IW2+NP2 
anne e ene FORM U=A*W1. 
WORK (A)= MASK-P(NP) 
CALL MPMLT(WORK(A) ,W,WORK(U) , WORK (IW1) , WORK (IW2) , WORK (EW3) , 
* 1,NP,NPP1, 2,NP2,NPM2) 


caleatenienenienahateentnteneeet USE KNUTH'S THEOREM 4.3.1.B AND LEADING DIGIT THEOREM 


TO SOLVE FOR J SUCH THAT J*P.LE. U .LT. (J+1)*P. 
R(1)=WORK (U)+1 
CALL MPMLT(R(1) ,P,WORK(JP) ,WORK(IW1) , WORK (IW2) ,WORK(IW3), 
* 1,NP,NPP1,2,NP2,NPM2) 
IF (KOMP (WORK (JP) ,WORK(U) ,NPP1).LE.@) GO TO 1 
CALL MPMLT (WORK(U) ,P,WORK(JP) , WORK (IW1) ,WORK(1IW2) ,WORK(IW3), 
* 1,NP,NPP1,2,NP2,NPM2) 
------~--~----~- COMPUTE U MOD 2**Q -— JP MOD 2**Q. 
CALL MPSUB (WORK (U+1) ,WORK(JP+1) ,R,NP) 
CALL ADDP(W(NPP1) ,R,R,P,WORK(IW1) ,NP,NPM2+NP) 
RETURN 
END 


SUBROUTINE MODQ1(S,Y,P,WORK,NP1,NP,NW) 


ssesse=e===COMPUTE Y=S MOD P FOR (Q+1)-BIT S AND P=2**Q-A FOR UNSIGNED 


MULTIPRECISION INTEGERS S OF PRECISION NP1 AND 
Y,P OF PRECISION NP. 
WORDS. 
INTEGER S(NP1),Y(NP),P(NP) ,WORK (NW) 
COMMON /MACHIN/ISIZE,M,MAXPOS, MINNEG, MASK 
CALL MODQ(S(2),Y,P,NP) 


alastesietentatasieteneeteaten S(1), THE HIGH-ORDER PART OF S, IS EITHER ZERO OR ONE. 


IF(S(1).EQ.@) RETURN 
aan eee RECOVER A=2**Q-P 
DO 1 I=1,NP 
WORK (I)=9 
WORK (NP) =MASK-P (NP) 


C--~--~------- COMPUTE SUM=MODQ(S MOD 2**Q)+A*S(1). 


CALL MPADD(Y ,WORK,WORK(NP1) ,NP,NP1) 
CALL MODQ (WORK (NP1+1) ,Y,P,NP) 
RETURN 

END 


SUBROUTINE MODQ(X,Y,P,NP) 


C=s=s=======COMPUTE X MOD P FOR Q-BIT X AND P=2**Q-A FOR UNSIGNED 
C MULTIPRECISION INTEGERS X,Y,P OF PRECISION NP. 


C 


1 


INTEGER X(NP),Y(NP),P(NP) 

IF (KOMP (X,P,NP).GE.@) GO TO 2 
-------~--~-- Y=X, 

DO 1 I=1,NP 

Y¥(I)=X(1) 


WORK IS A WORKSPACE OF NW=2*NP+1 


06002310 
06002320 
06002330 
06002340 
060062350 
06002360 
00002370 
006002386 
00002390 
00002400 


00002410 
00002420 
09002430 
00002440 
06002450 
00002460 
00602476 
00002480 
06002490 
00002500 
06002510 
00062520 
06002530 
00002540 
00002550 
$006062560 
$0002570 
00002586 
06002590 
90002600 
00002610 
00002620 
000602630 
00002640 
00002650 
00002660 
00002670 
00002680 
00002696 
000062700 
009002710 
00002720 
00002730 


90002740 
009002750 
06002760 
00602770 
00002780 
00002790 
000028060 
00002810 
00002820 
00002836 
00902840 
00006285¢ 
06002860 
00002870 
00002880 
00002890 
90002900 
00002916 
060062920 


06002930 
60002946 
00062950 
00962960 
00002970 
00002986 
60662990 
606030600 


536-P 6-0 


COLLECTED ALGORITHMS (cont.) 


RETURN 
es Y=X-P 
2 CALL MPSUB(X,P,Y,NP) 
RETURN 
END 
SUBROUTINE MPMLT(IX,IY,IZ,U,V,W,NX,MY,NPM,N2,M2,NPM2) 
C====s=2=22===JJNSIGNED MULTIPRECISION INTEGER MULTIPLICATION 
Cc IZ=IX*1IY. NX,MX,NPM ARE THE PRECISIONS OF THE UNSIGNED 
Cc INTEGERS IX,1Y,IZ RESPECTIVELY. U,V,W ARE 
C WORKSPACES OF N2=NX*2, M2=MY*2, AND MPN2=(NX+MY)*2 WORDS 
Cc RESPECTIVELY. NO INTEGER OVERFLOWS ARE GENERATED. 
C 
C SEE KNUTH'S ALGORITHM 4.3.1 M. 
Cc 
INTEGER IX(NX), LY(MY),IZ(NPM) ,U(N2) ,V(M2) ,W(NPM2) 
INTEGER T(2),K,SHIFT1,V@ 
COMMON /MACHIN/ ISIZE,M,MAXPOS ,MINNEG, MASK 
SHIFT1=2** (M/ 2-1) 
C---------- DOUBLE THE PRECISION SINCE FORTRAN CANNOT ACCESS THE 
Cc PRODUCT OF TWO M-BIT WORDS. 
DO 19 I=1,NX 
I2=1*2 
10 CALL SPLIT (IX(TI) ,U(1I2-1) ,U(I2)) 
DO 11 I=1,MY 
L2=1%*2 
ak) CALL SPLIT(IY(I),V(12-1) ,V(12)) 
C-~-------- BEGIN KNUTH'S ALGORITHM. 
DO 1 I=1,NPM2 
1 W(I)=@ 
J=M2 
C---------- THE PROBABILITY OF V(J)=@ IS SMALL. SKIP STEP 2. 
3 I=N2 
K=9 
4 IPJ=I+J 
C---------- COMPUTE T=U(1L)*V(J)+W(I+J)+K WITHOUT INTEGER OVERFLOW. 
V@=MOD (V(J) ,SHIFT1) 
CALL LADD(U(I)*V@, (V(J)-V@)*U(I), IZ) 
CALL LADD(IZ(2), W(IPJ)+K, T) 
C-----—~~~-- COMPUTE K = FLOOR(T/2**(M/2)), W(IPJ)=T MOD 2**(M/2), 
C THE HIGH AND LOW-ORDER HALFS OF T(2). 
CALL SPLIT(T(2) ,K,W(IPJ)) 
5 I=I-1 
IF(I.GT.@) GO TO 4 
W(J)=K 
6 J=J-1 
IF(J.GT.@) GO TO 3 
C~--------- CONVERT THE RADIX 2**(M/2) DIGITS TO RADIX 2**M DIGITS. 
DO 12 I=1,NPM 
T2=I*2 
19 IZ(1)=JOIN(W(12-1) ,W(12)) 
RETURN 
END 
SUBROUTINE MPADD(U,V,W,N,NP1L) 
C===2s=====s===UNSIGNED MULTIPRECISION INTEGER ADDITION, 
C W=U+V. N IS THE PRECISION OF UNSIGNED NUMBERS, IX, IY. 
Cc W IS THE UNSIGNED NP1-WORD PRODUCT. 
C 
C SEE KNUTH'S ALGORITHM 4.3.1-A. 
INTEGER U(N),V(N) ,W(NP1) ,SUM1(2) ,SUM2(2) 
1 J=N 
K=@ 
2 CALL LADD(U(J) ,V(J) ,SUM1) 
CALL LADD(SUM1(2) ,K,SUM2) 
K=SUM1(1)+SUM2(1) 
W(J+1)=SUM2 (2) 
3 J=J-1 
IF(J.GT.@) GO TO 2 
W(1)=K 
RETURN 


END 


60063010 
00063620 
00003030 
006030640 
60003050 


00003060 
00003070 
06003080 
00003090 
00003100 
00003110 
00003120 
00003130 
000063140 
00003150 
06003160 
06003176 
90003180 
00003190 
06003200 
96003210 
06003220 
00003230 
00903246 
96003250 
990603260 
06063276 
00003280 
06003290 
064603300 
00003316 
00003320 
00003330 
06003340 
90003350 
06003360 
06003370 
090003380 
00003390 
00903400 
00003410 
06003420 
AOGO34 30 
006003440 
$0003450 
AOOO3460 
69003470 
16003480 
06063496 
00003500 
$69003510 
00003520 


00003530 
00003540 
00003550 
06003560 
00003570 
000603580 
00603590 
90003600 
06003616 
00003620 
$0003630 
000063640 
00003650 
06003660 
06003670 
000063680 
90603690 
800063700 
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SUBROUTINE MPSUB(U,V,W,N) 


z=sassse===[NSIGNED MULTIPRECISION INTEGER SUBTRACTION, 


W=U-V IGNORING POSSIBLE BORROW IF U IS LESS THAN V. 
N IS THE PRECISION OF UNSIGNED NUMBERS U,V,W. 


SEE KNUTH'S ALGORITHM 4.3.1-S. 
INTEGER U(N),V(N) ,W(N) ,DIF1(2) ,DIF2(2) 
J=N 
K=¢ 
CALL LSUB(U(J),V(J),DIF1) 

CALL LSUB(DIF1(2) ,K,DIF2) 
K=DIF1(1)+DIF2(1) 
W(J)=DIF2(2) 

J=J-1 

IF(J.GT.@) GO TO 2 
RETURN 

END 


FUNCTION KOMP (U,V,N) 


CXXXXXXXXX FUNCTION TO COMPARE UNSIGNED MULTIPRECISION 


C 


O.ON 


INTEGERS U,V OF PRECISION N. KOMP=-1 IF U IS LESS THAN V, 
+1 IF U IS GREATER THAN V, AND @ IF U=V. 


SEE KNUTH PROBLEM 4.3.1-11 
INTEGER U(N),V(N) 
DO 1 J=1,N 


Saltetaeteateatad IF HIGH-ORDER BITS DIFFER U .NE. V. 


IF(ISIGN(1,U(J)).NE.ISIGN(1,V(J))) GO TO 2 


colenasheneteet ELSE IF U IS LESS THAN V, THEN KOMP=-1 


IF(U(J).LT.V(J)) GO TO 3 


ateietenenenes ELSE IF U IS GREATER THAN V THEN KOMP=+1. 


IF(U(J).GT.V(J)) GO TO 4 
CONTINUE 


------- THE OPERAND WITH HIGH-ORDER BIT ON IS GREATER. 


IF(U(J).LT.V(J))GO TO 4 
KOMP=-1 

RETURN 

KOMP=+1 

RETURN 

END 


FUNCTION JOIN (HALF1, HALF2) 


eo ROUTINE TO CONVERT TWO RADIX 2**(M/2) DIGITS HALF1, 


AQAAAMQARIAAA 


HALF2 TO A RADIX 2**M DIGIT, JOIN. THAT IS THIS 
ROUTINE FORMS A M-BIT NUMBER WITH THE HIGH-ORDER ISIZE-M 
BITS EQUAL TO ZERO, THE M/2 HIGH-ORDER BITS BEING THE M/2 
LOW-ORDER BITS OF HALF1, AND THE M/2 LOW-ORDER BITS BEING 
THE M/2 LOW-ORDER BITS OF HALF2. 
THIS IS DONE WITHOUT CAUSING AN INTEGER OVERFLOW AND 
ASSUMING M IS EVEN, AND HIGH-ORDER (ISIZE-M)+M/2 BITS OF 
EACH HALF ARE ZERO. 

INTEGER HALF1,HALF2,1ISUM(2) ,SHIFT1 

COMMON /MACHIN/ISIZE,M, MAXPOS ,MINNEG, MASK 

SHIFT1=2** ((M/2)-1) 


a a ee FORM JOIN=HALF2+(2** (M/2))*HALF1 


IX=HALF1*SHIFT1 

CALL LADD(1IX,1IX,ISUM) 
JOIN=ISUM(2)+HALF2 
RETURN 

END 


SUBROUTINE SPLIT(IX,HALF1,HALF2) 


CXXXXXXXXXXXX ROUTINE TO CONVERT A RADIX 2**M DIGIT, IX TO TWO 


aAagAAaAA 


RADIX 2**(M/2) DIGITS HALF1,HALF2. THAT IS THIS 
ROUTINE SPLITS THE M-BIT NUMBER IX INTO HIGH-ORDER HALF 
HALF1 AND LOW-ORDER HALF2 WITHOUT CAUSING AN INTEGER 
OVERFLOW. THE HIGH-ORDER ISIZE-M BITS OF LX ARE ASSUMED 
TO BE ZERO. 

INTEGER X,HALF1,HALF2, SHIFT, ISUM(2) 

COMMON /MACHIN/LSLZE,M,MAXPOS, MINNEG , MASK 


60603710 
69003720 
80003730 
060063740 
060063750 
09003760 
000603770 
00003780 
00003796 
00003800 
$9003810 
00003820 
00003830 
09003840 
00003850 
06003860 
00003870 


000038890 
06063890 
06003900 
00903910 
009903920 
000063930 
06003940 
09063950 
60003960 
00003970 
06003980 
00003990 
06064000 
09904010 
00004026 
009040630 
90004046 
0006040650 
00004060 
060040670 
06004080 
90904090 
0090041060 
96004110 
00004120 


06004130 
00004140 
06004150 
00004160 
00004170 
99004180 
06004190 
00004200 
00004210 
40004226 
06004230 
00004240 
00604250 
00004260 
00004270 
00004280 
00004290 
00004300 
60004310 


00004320 
00004330 
99004340 
00004350 
09004360 
00004370 
00004380 
$0004 390 
00004400 
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SHIFT=2**% (M/2) 
X=IX 
IF(X.GE.@.AND.X.LE.MAXPOS) GO TO 2 


alee REMOVE SIGN BIT BEFORE DIVISION. 


CALL LADD(MINNEG, X, ISUM) 
HALF1=ISUM (2) /SHIFT+SHIFT/2 


Sot ses eS FORM X MOD 2**(M/2) 


HALF2=MOD (ISUM(2) , SHIFT) 
RETURN 

HALF 1=X/SHIFT 
HALF2=MOD (X, SHIFT) 
RETURN 

END 


SUBROUTINE LSUB(IU,IV, IW) 


CXXXXXXXXX SUBROUTINE TO PERFORM A LOGICAL SUBTRACT OF 2 M-BIT 


Cc 
C 
C 


NUMBERS IU, IV. IW(2) IS THEIR LOGICAL DIFFERENCE, 
IW(1) IS +1 IF THERE WAS A BORROW, ZERO OTHERWISE. 
SEE SUBROUTINE LADD. 

INTEGER IU,IV,1X,1Y,1W(2), 1SUM(2) 

COMMON /MACHIN/ISIZE,M,MAXPOS,MINNEG, MASK 

LX=IU 

LY=IV 

IW(1)=@ 


------- SORT OUT SPECIAL CASES FOR LADD. 


IF(IX.EQ.IY) GO TO 3 
IF(IY.EQ.6) GO TO 1 
IF(IY.EQ.MINNEG) GO TO 2 
CALL LADD (IX,MASK-IY, ISUM) 
IF(ISUM(1).EQ.6) IW(1)=1 
IW(2)=ISUM(2) 

RETURN 

IW(2)=1IX 

RETURN 

CALL LADD(IX, IY, SUM) 
IF(ISUM(1) .EQ.6) IW(1)=1 
IW(2)=ISUM(2) 

RETURN 

IW(2)=@ 

RETURN 

END 


SUBROUTINE LADD(IU,IV, IW) 


CXXXXXXXXXXXXX SUBROUTINE TO PERFORM A LOGICAL ADD OF THE LOW-ORDER 


CIF OO IO 


M BITS OF TWO COMPUTER WORDS, IU, IV. IW(2) IS THEIR 
LOGICAL SUM, IW(1) IS THE CARRY BIT VALUE. 

NO INTEGER OVERFLOWS OCCUR EVEN IF M=ISIZE. 

EXAMPLE - $111 LADD 1611 YIELDS IW(1)=1, IW(2)=@016, 
FOR M=4, MAXPOS=@111, MINNEG=1060¢, MASK=@ OR 100660. 


INTEGER IX,IY,U,IV,IW(2),DIF,NEG, POS, ISUM, BIG, SMALL, ISX, ISY, ISD 
COMMON/MACHIN/ISIZE,M, MAXPOS , MINNEG, MASK 
LX=IU 


soso ELIMINATE ZERO OPERANDS. 


IF(IX.EQ.@.OR.IY.EQ.@) GO TO 2 


Sesauessos DETERMINE IF IX,IY IS ++, --, OR + 


ISX=ISIGNM (IX) 
ISY=ISIGNM(IY) 
IF(ISX.NE.ISY) GO TO 5 
IF(ISX.LT.@) GO TO 3 


---------- ++ (BOTH OPERANDS HAVE HIGH-ORDER BITS OFF) 


DIF=MIN@ (IX, LY )— (MAXPOS—MAX@ (IX, IY)) 
ISD=ISIGNM (DIF) 

IF(ISD.LE.O) IW(2)=IX+IY 
LF(ISD.GT.@) IW(2)=(MINNEG+DIF)-1 
RETURN 


ateieienteaneina AT LEAST ONE OPERAND IS ZERO. 


IW(2)=IX+IY 
RETURN 


soccer (BOTH OPERANDS HAVE HIGH-ORDER BITS ON) 


IW(1)=1 
BIG=MAX@ (IX, LY) 


00004410 
06004420 
0004436 
00004446 
60004450 
10004460 
09004470 
69004486 
00004490 
DOOO4500 
60004510 
00004526 
09004530 


66004540 
00004550 
00004560 
06004570 
00004580 
00004596 
00004600 
00004616 
00004620 
90004630 
00004646 
00004650 
06004660 
66064670 
000064680 
006004696 
1060047060 
00004710 
000064720 
000064730 
00004740 
00004750 
06004760 
000604770 
00004780 
00004790 
00004800 


00004810 
09004820 
09004830 
00004840 
00004850 
00004860 
00064876 
96004880 
60004890 
000064900 
60904916 
0004920 
09004936 
00064940 
06004950 
00004960 
00004970 
60004986 
0004990 
60005000 
600650616 
00065620 
00605636 
09005040 
60005056 
00605060 
00005070 
00065080 
00005090 
00005100 
90005110 
060065120 
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SMALL=MIN@ (IX, IY) 


naa 


CXXXXXXXX FUNCTION TO RETURN @ IF IX=@, 1 IF @FIXFMAXPOS+1,-1 OTHERWISE. 


DIF=¢ 


IF (SMALL. 


NE.MINNEG) DIF=MINNEG-SMALL 


DIF=BIG-DIF 
IF(ISIGNM(DIF) .GE.@) GO TO 4 
IW(2)=( (MAXPOS+DIF)+1)-MASK 


RETURN 


IW(2)=IX+1Y 


RETURN 


+- (OPERANDS HAVE OPPOSITE HIGH-ORDER BIT VALUES). 


IW(2)=IX+1Y 


NEG=1X 
POS=IY 


IF (ISIGNM(IX).LT.@) GO TO 6 


NEG=IY 


IF ++(--(MINNEG,NEG),POS) IMPLIES A ++ INTEGER OVERFLOW 
THEN THERE WILL BE A CARRY FOR +-, 


ISUM= ( (MAXPOS+NEG) +1) -MASK 
IF (MING (ISUM, POS) .LE. (MAXPOS—MAX@(ISUM,POS))) RETURN 
IW(2)=IW(2)-MASK 


IW(1)=1 
RETURN 
END 


FUNCTION 


ISIGNM(IX) 


COMMON /MACHIN/ISIZE,M, MAXPOS ,MINNEG, MASK 


ISIGNM=1 


IF(IX.LT. 
IF(IX.EQ. 


RETURN 
END 


@.OR.IX.GT.MAXPOS) ISIGNM=-1 
@) ISIGNM=¢ 


00005130 
00005140 
16605150 
60005160 
00005170 
66005180 
$00065196 
00605200 
06005210 
06065226 
90005236 
06005240 
00005250 
00005260 
00005270 
00005286 
900605290 
00005300 
00005310 
00005320 
00005330 
06005340 
060605350 
009005360 


00005370 
90005380 
06905390 
A0605400 
00005410 
90005420 
$6005430 
00005440 


536-P10- 0 


COLLECTED ALGORITHMS FROM ACM 


537-P 1-0 


ALGORITHM 537 
Characteristic Values of Mathieu’s 
Differential Equation [S22] 


WALTER R. LEEB 
Technische Universitat Wien, Austria 


Key Words and Phrases: Mathieu’s differential equation, wave equation, characteristic values, 
eigenvalues, separation constants, Mathieu functions, ordinary Mathieu functions, modified Mathieu 
functions, elliptic cylinder functions, hyperbolic cylinder functions 

CR Categories: 5.14, 5.17 

Language: Fortran 


DESCRIPTION 


The algorithm calculates the characteristic values 6 of Mathieu’s differential 
equation 


d’y/dx” + (b — Scos’x) y =0 (1) 


for solutions y(x) of periodicity 7 or 27. In this case b is a function of S and 
belongs to a countably infinite set of values for every S [2]. The knowledge of 6 
is a prerequisite for calculating ordinary and modified Mathieu functions. 

The program has been tested for real S-parameters between zero and 1000, and 
for a number of characteristic values of up to 24, depending on the value of S. 
(For negative S, simple equations exist which relate the corresponding 6 to those 
for positive S [2, p. xvii]). The calculated 6 are correct to at least 9 decimal places. 
Within the calculated finite subset of 6, the characteristic values are arranged 
with increasing magnitude, the first value being the smallest of the infinite set. 
The algorithm uses a library subroutine to find the eigenvalues of a real symmetric 
tridiagonal matrix. 

Four types of solutions y(x) can be distinguished: An odd and an even solution 
with period 27, and an odd and an even solution with period 7. The corresponding 
characteristic values 6 are called 602,41, b@2-+1, bO2,+2,' and be2,. (r = 0, 1, 2,...; 
within each of the four sets, the smallest index is used for the smallest value of 0.) 
Upon insertion of y(x) in the form of Fourier series into eq. (1), a system of 
homogeneous, linear equations for the Fourier coefficients is obtained [2]. The 
determinant of the resulting square coefficient matrix of infinite order has to 
equal zero for nontrivial y(x). This characteristic equation determining the 


' Note the difference in the index notation for 602,42 compared with [2], where this set of characteristic 
values is called bo2,. We have thus avoided unequal starting values for r among the four sets. 
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characteristic values b may be written as 
|BI-A|=0, (2) 


where £8 = b — S/2 and J is the identity matrix. In the case of y being odd with a 
periodicity of 27, the elements of the matrix A are found to be 


ay=1—-— S/4; Qi-1,i = A,i-1= S/4, agi = (2i = 1)? for 1= 2, 


and all the other a, are equal to zero. Therefore, after adding S/2, the eigenvalues 
of the real symmetric tridiagonal matrix A (of unrestricted order) yield the 
characteristic values b02;+1. 

Correspondingly, one can show that the be2,+1, b02,+2, and be, are given by the 
eigenvalues of matrices which we call B, C and D, respectively. The nonzero 
elements of all four matrices have been compiled in T'able I. When proceeding 
the way outlined above, the matrix D’ determining the characteristic values bez, 


Table I. Nonzero Elements for Calculation of Characteristic Values 


Characteristic 
value Matrix elements 
bo2r+1 ay = 1—S/4; a1; = ai-1=S/4 and a;=(2i-—1)? for t=2 
be 2,41 bi, =1+ S/4; bi-1. i= bii-1 = S/4 and b:: = (2t = 1)? and i>2 
b02;+2 Ci = Ai? for i= 1; ¢.i-1 = Cig = S/4 for 122 
beo, dip. = do = S/ (8'/2); ay» =4 
dij =4(t-1)? and diyi=dii-n =S/4 for i=3 
20 
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Fig. 1. Order of matrix (A, B, C, or D) necessary to give the first L characteristic values 6 correct to 
nine decimal places. Data points (O, A, 0, *, and ©) represent numerically found nin in case of 
matrix D, while the full lines represent the function N(S, L) according eq. (3). For clarity, only five 
values of L are presented. 
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turns out to be tridiagonal but unsymmetric. The only reason for unsymmetry is 
that diz = S/4 is unequal dé; = S/2. Proper similarity transformation produces 
a symmetric tridiagonal matrix D with dj. = dz; = S/(8'””) and all other elements 
remain unchanged. This allows the use of one and the same library subroutine 
for determining the eigenvalues of all four matrices. 

Next, one has to establish the minimum order nmin of the matrix A (or B, C, D) 
such as to yield a number L (LZ < mnin) of characteristic values with given 
accuracy. In a modification of the program presented here, and using a trial and 
error method, we determined nmin aS a function of both S and L for a b-accuracy 
of 9 decimal places. This was done for some discrete values of S and for integer 
L in the domain 0 = S = 1000 and 0 S mmin S 24. The results are shown in Fig. 1 
for some selected values of L. Then an analytic function N(S, L) was developed 
which closely approximates Nin, but ensures N = nmin: 


N(S, L) = int((0.17 + 2.1 exp(—0.24 L))SO7-/O>*) + T+ 2.8). (3) 


The function N(S, L) is presented in Fig. 1 as full line for the same parameters 
L as the numerically evaluated nmin(S, L). There are only minor differences in 
Nmin required for A, B, C, and D, and eq. (3) has been determined as to fulfill 
N = Mnin for all four matrices; therefore, it will be used for all four sets of 
characteristic values. 


EXAMPLES 


Find b0,, 603,..., b029 for S = 2, also bei, bes,..., ber for S = 1000; in addition, 
bo2, bo4s,..., 6038 for S = 100, and beo, bez,..., beig for S = 0.1. The results 
computed with a CDC CYBER/16 are given in Table II. Part of these results can 
be compared with tabulated values [2] and show agreement. 


ACKNOWLEDGMENT 


Thanks are due to the Computer Center of the Technische Universitat Wien, 
which provided free computer time, and to R. Welser for his assistance. 


Table II 
S-s 2eu% CHARACIERISTIC VALUES S = 2000600 CHARACTERISTIC VALUES 
BO 1 = 1. 470654255 BE 1 = 93,599796781 
BO 3 = 10,.013719839 BE 3 = 214.914687921 
Bo 5 = 26.005209019 BE 5S = 331. 837262869 
BO 7 = 59.002604266 Bc 7 = 444,0679857151 
RO 9 = 82.061562529 
BOLL = 122.u01041673 
B0o13 = 170.000744050 
BO1L5S = 226€,00u558037 
BO17 = 290.00C424028 
BO19 = 362,000347222 
BO2Z21 = 442.000284091 S = 100.00 CHARACTERISTIC VALUES 
PO23 = 530.004236742 
2025 = 626.000200321 BO 2 = 28685139778 
BO27 = 730.000171703 BO 4 = 62,986489953 
BO29 = 842,000148899 20 6 = 91.801071292 
BO 8 = 119.057988351 
BO10 = 153, 22568042 
BO12 = 196.207674647 
BO14 = 247. 611164915 
S = 010 CHARACTERISTIC VALUES 8016 = 307.229284862 
BO18 = 374696934459 
BE 0 = 2049687521 BO20 = 450.784185569 
Fe 2 = 4%, 0562E€0395 BO22 = 534.647547063 
BE 4 = 166050020834 BO24 = 62€.542802911 
PE 6 = 36.050008929 BO26 = 726, 463162768 
RE @ = 64.0506004960 BO28 = 834.3992 34146 
B2i10 = 100.050003157 BO30 = 950.3476093024 
RE12 = 144.050002185 BO32 =1074. 365531439 
BELG = 196.0506601603 B034 =1206. 2706025386 
BE16 = 256.050001225 BO36 =1346,. 241340972 
E£18 = 324.056000967 BO38 =1494, 21658231141 


COLLECTED ALGORITHMS (cont.) 


REFERENCES 
[Note. Reference [1] is not mentioned in the text. ] 


1. Goos, G., AND HARTMANIS, J. Eds., Lecture Notes in Computer Science, vol. 6, Springer, New 


York, 1976. 


2. National Bureau of Standards, Tables Relating to Mathieu Functions. Cambridge U. Press, New 


York, 1951. 


ALGORITHM 


SUBROUTINE CHARMA(KIND, S, L, NMAX, VAL, SUD, IA) 
SUBROUTINE CHARMA CALCULATES THE CHARACTERISTIC VALUES OF 
MATHIEU-S DIFFERENTIAL EQUATION FOR ODD OR EVEN SOLUTZONS 
WITH PERIODICITY PI OR 2*PI. 

A LIBRARY SUBROUTINE HAS TO BE ATTACHED TO CALCULATE ‘THE 
EIGENVALUES OF A REAL SYMMETRIC TRIDIAGONAL MATRIX. IN THE 
PRESENTED FORM, THIS IS THE EISPACK ROUTINE IMTQL1. 
INPUT.. 

KIND AN INTEGER CHARACTERIZING THE KIND OF CH. V. 

IF KIND=1, THE CH. V. BO 1, BO 3,... FOR ODD SOLUTIONS 
WITH PERIODICITY 2*PI ARE CALCULATED 

IF KIND=2, THE CH. V. BE 1, BE 3,... FOR EVEN SOLUTIONS 
WITH PERIODICITY 2*PI ARE CALCULATED 

IF KIND=3, THE CH. V. BO 2, BO 4,... FOR ODD SOLUTIONS 
WITH PERIODICITY PI ARE CALCULATED 

IF KIND=4, THE CH. V. BE @, BE 2,... FOR EVEN SOLUTIONS 
WITH PERIODICITY PI ARE CALCULATED 

CHARMA DOES NOT DESTROY KIND 

S REAL NON-NEGATIVE VARIABLE, THE PARAMETER OF THE 
DIFFERENTIAL EQUATION. FOR S UP TO 16@@ AN ACCURACY OF 
9 DECIMAL PLACES IS GUARANTEED FOR THE CHARACTERISTIC 
VALUES IF THE NUMBER OF THE CH. V. IS NOT TOO HIGH. 
(SEE FIG. 1 OF DESCRIPTION) 

1 INTEGER VARIABLE, THE NUMBER OF CHARACTERISTIC VALUES 
TO BE CALCULATED. IT CAN BE NO LARGER THAN NMAX. 

NMAX INTEGER VARIABLE, MAXIMUM DIMENSION OF THE MATRIX USED 
FOR THE CALCULATION. TO MAKE USE OF THE FULL TESTED 
DOMAIN WITH AN ACCURACY OF 9 DECIMAL PLACES, IT SHOULD 
BE AT LEAST 24. 

OUTPUT... 

VAL REAL ONE-DIMENSIONAL ARRAY OF DIMENSION (NMAX). 
INITIALLY IT CONTAINS THE DIAGONAL ELEMENTS OF THE 
COEFFICIENT MATRIX. ON EXIT, ITS FIRST L ELEMENTS WILL 
CONTAIN THE CH. V. 

IA INTEGER VARIABLE USED AS A FAILURE INDICATOR. IF, ON 
EXIT, ITA=@, NO FAILURE WAS DETECTED. IF IA=1, S WAS 
NEGATIVE. IF IA=2, L WAS CHOSEN TOO BIG, REQUIRING A 
LARGER NMAX. IF IA=3, THE LIBRARY SUBROUTINE IMTQL1 
DID NOT FIND ALL EIGENVALUES. FOR IA=1, 2, OK 3, NO 
CHARACTERISTIC VALUES WERE CALCULATED. IF IA=4, 

S .GT. 16@@. IF IA=5, L WAS TOO LARGE (FOR THE GIVEN 
S), REQUIRING AN ORDER N OF THE COEFFICIENT MATRIX 
WHICH EXCEEDS THE TESTED DOMAIN (N .LE. 24). FOR IA=4 
OR 5 THE CALCULATION WAS EXECUTED, BUT ACCURACY OF THE 
CHARACTERISTIC VALUES TO NINE DECIMAL PLACES IS NOT 
GUARANTEED. IN THESE CASES, ACCURACY MAY BE CHECKED AS 
FOLLOWS. IF L=L1 PRODUCES IA=4 OR 5, TAKE A VALUE L=L2, 
L2=L1+1, COMPUTE VAL (IA WILL AGAIN BE 4 OR 5) AND COMPUTE 
THE DIFFERENCE OF THE FIRST L1 MEMBERS OF BOTH SEQUENCES. 
IF THE ERROR TEST IS PASSED, ACCEPT THE ANSWER, IF NOT TAKE 
A VALUE L=L3=L2+1, ETC... 
OTHER PARAMETERS.. 
SUD A ONE-DIMENSIONAL REAL ARRAY OF DIMENSION (NMAX), 

INITIALLY CONTAINING IN ITS POSITIONS (2), (3),..., (N) 
THE SUBDIAGONAL ELEMENTS OF THE COEFFICIENT MATRIX . 

N INTEGER VARIABLE, THE ORDER OF THE COEFFICIENT MATRIX 

IB AN INTEGER VARIABLE TO TEST THE SUCCESS OF IMTQL1. IF, 
ON EXIT, IB=@, IMTQL1 HAS DETERMINED ALL EIGENVALUES 
WITHIN 3@ ITERATIONS. 

REAL FL, S,-SUD, VAL 

INTEGER I, IA, IB, IOUT, KIND, L, N, NMAX 

DIMENSION VAL(NMAX), SUD(NMAX) 

IA = @ 

C TEST FOR NEGATIVE S 
IF (S.GE.6.0E@) GO TO 16 


MQaANMQAANQAANANRARGaANAANNRNNANANAANANANAANAANAANANANAANDNAANANNARAANANANANANANRAANANANaANNnNaAanNAaNaAN AA 


60660010 
0006620 
60006030 
60906040 
600000656 
bOd0OH60 
699060676 
66000086 
OO4O0090 
66660100 
60660116 
69060126 
60009130 
60000146 
60066150 
606000166 
60600170 
60000186 
96000190 
60000260 
0000216 
$6606220 
06000236 
66900240 
96600250 
90006266 
90060270 
66000286 
66600290 
$6666300 
10000310 
$0660326 
66060336 
96600340 
40000350 
60060366 
60000376 
19606380 
09960390 
666604060 
60000416 
0066420 
0000436 
90000440 
06000450 
60060460 
66006470 
96000480 
90000490 
09600500 
60000519 
60000520 
60000530 
00000540 
0000550 
60066560 
00660570 
60660580 
66000596 
60600600 
0000616 
69000626 
19600630 
09060646 
60000656 
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IA = 1 
RETURN 


Oo. £3.50 


TEST FOR S GREATER 166@. IF TRUE, CALCULATION IS CONTINUED 
BUT ACCURACY OF THE CHARACTERSTIC VALUES TO NINE DECIMAL 
PLACES CANNOT BE GUARANTEED. 
FOR IMPROVEMENT. 


SEE COMMENT ON IA IN OUTPUT LIST 


16 IF (S.LE.100¢.0EG) GO TO 206 
ITA = 4 
C DETERMINE NECESSARY ORDER OF MATRIX TO ACHIEVE AN ACCURACY 
C OF 9 DECIMAL PLACES FOR THE CHARACTERISTIC VALUES. 


20 FL = 


Ne= 
* (9 


FLOAT (L) 
INT ((O.17EG+2. 1EO*EXP (-G. 24EQ@*FL) )*S**(@. 77EG-5.GEO/ 


- 5SEQ+FL) )+FL+2. 8E@) 


C TEST FOR SUFFICIENT LARGE NMAX 
IF (N.LE.NMAX) GO TO 3@ 
IA = 2 
RETURN 


aaAaaAaaAN 


TEST WHETHER N IS WITHIN TESTED DOMAIN FOR WHICH ACCURACY TO 9 
DECIMAL PLACES IS GUARANTEED. IF NOT, CALCULATION IS CONTINUED 
BUT ACCURACY OF THE CHARACTERSTIC VALUES TO NINE DECIMAL 
PLACES CANNOT BE GUARANTEED. 
FOR IMPROVEMENT. 


SEE COMMENT ON IA IN OUTPUT LIST 


3@ IF (N.LE.24) GO TO 4¢ 
TA = 5 


aAaAaAaAa 


BRANCH ACCORDING TO DESIRED SOLUTION: 

IF KIND=1, USE MATRIX CALLED A IN THE DESCRIPTION 
IF KIND=2, USE MATRIX CALLED B IN THE DESCRIPTION 
IF KIND=3, USE MATRIX CALLED C IN THE DESCRIPTION 
IF KIND=4, USE MATRIX CALLED D IN THE DESCRIPTION 


46 GO TO (56, 60, 94, 116), KIND 


aq 


STORE DIAGONAL ELEMENTS OF THE COEFFICIENT MATRIX IN VAL AND 
SUBDIAGONAL ELEMENTS IN SUD(2), SUD(3),... 


» SUD(N). 


5@ VAL(1) = 1.6E@ - S/4.QE@ 
GO TO 7¢ 

6@ VAL(1) = 1.6E@ + S/4.@E@ 

76 DO 8@ T=2,N 


VAL(I) = FLOAT((2*I-1)**2) 
SUD(I) = $/4.@E@ 
8¢ CONTINUE 
GO TO 13¢ 


9@ VAL(1) = 4.@E@ 
DO 16¢ I=2,N 


VAL(T) 
SUD(T) 


= FLOAT((2*1)**2) 
= S/4.0EO 


166 CONTINUE 
GO TO 13¢ 


11¢ VAL(1) = 
VAL(2) = 
SUD(2) = 
DO 12¢ 


@. GEO 

4. GEO 
S/SQRT(8.@EG) 
I=3,N 


VAL(I) = FLOAT((2* (I-1) )**2) 


SUD (TI) a 


S/4.QE@ 


12@ CONTINUE 
13@ CALL IMTQLI(N, VAL, SUD, IB) 
C TEST FOR SUCCESSFUL IMTQL1 
IF (IB.EQ.@) GO TO 14¢ 
IA = 3 
RETURN 


C ADD S/2 


TO THE EIGENVALUES OF THE MATRIX TO GET THE CH. V. 


14@ DO 15@ I=1,L 
VAL(I) = VAL(I) + S/2.@E@ 
15@ CONTINUE 
RETURN 


END 


C PROGRAM TECHV (INPUT,OUTPUT, TAPE5=INPUT, TAPE6=OUTPUT ) 


C THIS IS A PROGRAM TO TEST THE SUBROUTINE CHARMA WHICH CALCULATES THE 
C CHARACTERISTIC VALUES OF MATHIEU'S DIFFERENTIAL EQUATION FOR ODD OR 


C EVEN SOLUTIONS WITH PERIODICITY PI OR 2*PI. 


C INPUT.. 


A REAL VARIABLE, THE PARAMETER OF THE DIFFERENTIAL EQUATION 
AN INTEGER, THE NUMBER OF CHARACTERISTIC VALUES TO BE 
CALCULATED 


06000666 
06060670 
$6000680 
06000690 
06060700 
06606710 
00600720 
66000730 
06000740 
06000750 
00000760 
66060770 
606060780 
66000790 
POOOH800 
46000816 
90666826 
060600830 
06000840 
06900850 
00000860 
00600876 
96000886 
96000890 
09606900 
96000910 
006006920 
$90600930 
09000940 
00000950 
66000960 
090060970 
06000980 
06000990 
060010600 
606601016 
06061020 
666010636 
66001046 
060610650 
66001960 
600010676 
006010680 
006010690 
$06001106 
40001114 
06001126 
09001130 
60601140 
66001156 
60001160 
$0061170 
06001180 
06601196 
00061200 
909001210 
06061220 
06001230 
06001246 
00001250 
06061260 
06001270 
00001280 
600601290 


00061306 
66001316 
00001320 
06001330 
09001346 
06061350 
06001360 
06001370 
060601386 


AN INTEGER USED AS A FAILURE INDICATOR. IF, ON EXIT, IA=¢, NO 660061396 
FAILURE WAS DETECTED. IF TA=1 OR IA=2 OR IA=3, A FAILURE WAS 6606061460 
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@ REGISTERED AND NO CHARACTERISTIC VALUES WERE CALCULATED. 60001410 
C VAL A ONE-DIMENSIONAL ARRAY USED BY CHARMA AND BY A LIBRARY 00061426 
Cc SUBROUTINE. THE DIMENSION OF VAL SHOULD BE EQUAL OR GREATER 060601430 
Cc THAN 24 TO ACHIEVE FULL ACCURACY OVER THE WHOLE TESTED DOMAINEG@0601446 
C OF CHARMA. ON EXIT, VAL CONTAINS THE CHARACTERISTIC VALUES.  $000145¢ 
C INDE INTEGER VARIABLE, THE INDEX OF THE CHARACTERISTIC VALUES 00601460 
C KIND AN INTEGER CHARACTERIZING THE KIND OF CHARACTERISTIC VALUE 00001476 
Cc TO BE CALCULATED 00001480 
Cc SUD A ONE-DIMENSIONAL ARRAY USED BY CHARMA AND BY A LIBRARY 60061490 
C SUBROUTINE. THE DIMENSION OF SUD SHOULD BE EQUAL OR GREATER 06001500 
Cc THAN 24 TO ACHIEVE FULL ACCURACY OVER THE WHOLE TESTED DOMAINE@@0015106 
Cc OF CHARMA. $9001520 
C THE FOLLOWING DATA CARDS HAVE BEEN USED FOR THIS TEST PROGRAM (S=-1. 90060153@ 
C SIGNALS END OF DATA) 00001546 
GC 2. 15 06001550 
C19@1. 4 00001560 
C @.@1 25 00001570 
Cc 1¢. 27 00001580 
C -6. 3 00601590 
Cc <1. 060601600 
DIMENSION VAL(28), SUD(28) 00061610 

1@ READ (5,99999) S, L 90001620 

IF (S.EQ.-1.) GO TO 8@ 00001630 

C TEST SUBROUTINE FOR ALL FOUR KIND OF SOLUTIONS 00001646 
DO 7@ KIND=1,4 00001650 

CALL CHARMA(KIND, S, L, 28, VAL, SUD, IA) 00001660 

IF (IA.GT.@) WRITE (6,99993) S,; L, IA 00001670 

IF ((IA.GT.6) .AND. (IA.LT.4)) GO TO 10 006061686 

WRITE (6,99998) S 00001690 


C PRINT THE FIRST L ELEMENTS OF VAL, WHICH ARE THE CHARACTERISTIC VALUES#G061706@ 


DO 66 I=1,L 06001716 

C GIVE NAMES AND INDICES OF CH. V. ACCORDING KIND OF SOLUTION 00001720 
GO TO (26, 30, 46, 5@), KIND 90001730 

20 INDE = 2%I - 1 60001740 
WRITE (6,99997) INDE, VAL(I) 00601756 

GO TO 60 06001766 

30 INDE = 2*I - lL 000017706 
WRITE (6,99996) INDE, VAL(I) 40001780 

GO TO 6¢@ 60001796 

4g INDE = 2%1 09001800 
WRITE (6,99995) INDE, VAL(T) 60001810 

GO TO 60 $0601820 

5¢ INDE = 2*I - 2 66001830 
WRITE (6,99994) INDE, VAL(L) 00001840 

60 CONTINUE 60001850 

7@ CONTINUE 00001860 

GO TO 1¢ 60001870 

8@ CONTINUE $0001880 
STOP 90001890 

99999 FORMAT (F8.2, 2X, I2) 000019060 
99998 FORMAT (1H@, 17X, 3HS =, F8.2, 2X, 19HCHARACTERISTIC VALU, 00001910 
* 2HES/) $6001926 
99997 FORMAT (31X, 2HBO, 12, 2H =, F14.9) 00001930 
99996 FORMAT (31X, 2HBE, 12, 2H =, F14.9) 00001940 
99995 FORMAT (31X, 2HBO, 12, 2H =, F14.9) 00001950 
99994 FORMAT (31X, 2HBE, 12, 2H =, F14.9) 90001966 
99993 FORMAT (1H@, 30X, 1OHDATA - S =, F8.2/38X, 3HL =, 00001976 
* 13//26X, 1I5HERROR FLAG IA =, 13//) 00001980 

END 00001990 

C 0006062000 
C see enna ene on $06020610 
Cc 8OOO2620 
SUBROUTINE IMTQLI1(N,D,E,IERR) 00902030 

C $00020640 
INTEGER 1,J,L,M,N,11,MML,IERR 600020650 

REAL D(N),E(N) 800020660 

REAL B,C,F,G,P,R,$,MACHEP $00620670 

C REAL SQRT,ABS,SIGN 00002080 
Cc 00062090 
Cc THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE IMTQL1, 600062160 
Cc NUM. MATH. 12, 377~383(1968) BY MARTIN AND WILKINSON, 00002110 
Cc AS MODIFIED IN NUM. MATH. 15, 45@(1976) BY DUBRULLE. 00002120 
6 HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 241-248(1971). 06062130 
Cc $006214¢6 
c THIS SUBROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC 00002150 
Cc TRIDIAGONAL MATRIX BY THE IMPLICIT QL METHOD. 00602160 
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AaAagangangqaananaananaganaananananannnananaannanannaaana 


a 


166 


165 


ON INPUT- 


N IS THE ORDER OF THE MATRIX, 
D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, 


E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX 
IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY. 


ON OUTPUT- 


D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN 
ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND 
ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE 
THE SMALLEST EIGENVALUES, 


E HAS BEEN DESTROYED, 


IERR IS SET TO 
ZERO FOR NORMAL RETURN, 
J IF THE J-TH EIGENVALUE HAS NOT BEEN 
DETERMINED AFTER 3¢ ITERATIONS. 


QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, 
APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY 


RAKKKKKKKK MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING 
THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. 


ERKEKKRKEKK 


MACHEP = 2.**(~26) 


IERR = @ 
IF (N .EQ. 1) GO TO 1641 


DO 166 I = 2, N 
E(I-1) = E(I) 


E(N) = 6.¢ 


DO 299 L= 1, N 


J=96 


KAAAKKAKAK LOOK FOR SMALL SUB-DIAGONAL ELEMENT *#**##kde kx 


DO 110 M=L, N 
IF (M .EQ. N) GO TO 126 


IF (ABS(E(M)) .LE. MACHEP * (ABS(D(M)) + ABS(D(M+1)))) 


GO TO 12¢ 
CONTINUE 
P = D(L) 


IF (M .EQ. L) GO TO 215 
IF (J .EQ. 30) GO TO 1640 
J=xJ+i1 


KRKKKAKKKK FORM SHIFT #AkkRRRAKK 


G = (D(L+1) - P) / (2.0 * E(L)) 
R = SQRT(G*G+1.@) 
G = D(™) - P + E(L) / (G + SIGN(R,G)) 
S=1.¢ 
C= 1.6 
P = ¢.0 
MML = M- L 
REKKKEKKKK FOR I=M-1 STEP -1 UNTIL L DO -- RKRKEKKKKARKE 
DO 20¢@ II = 1, MML 
I=M-II 
F=S * E(I) 
B=C * E(I 
IF (ABS(F) .LT. ABS(G)) GO TO 15@ 
C=G/F 
R = SQRT(C*¥C+1.9) 
E(I+1) = F*R 
S=1.¢6/R 
c=Cc*S 
GO TO 16¢ 


06062170 
00602180 
49602196 
006002200 
06002210 
006002220 
006002230 
00002240 
00602250 
00002260 
00002276 
06002286 
00002296 
000023060 
000062316 
190002320 
06002 330 
60002340 
000602350 
606062360 
06002370 
0006062380 
060062390 
000602460 
06002410 
00002420 
000602430 


ae oe ee ee a ee ee GOOG2440 


00002450 
00002466 
000062470 
000602486 
006602490 
00602500 
060025106 
000602520 
009002530 
60002540 
06002550 
00602560 
006002570 
060062586 
0066062596 
906026060 
06002610 
90002626 
000062630 
06002640 
00002650 
06002660 
00002670 
00062680 
000062690 
060027060 
00002710 
06002720 
000062730 
00602740 
00002750 
00062760 
$0002770 
00062780 
696027990 
66002860 
496062816 
60002820 
00002830 
00002840 
06002850 
90002860 
06002870 
600602880 
60002890 
100062900 
06002916 
00002920 
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150 


16¢ 


200 


215 


S = 


R = SQRT(S*S4+1.0) 
E(I+1) =G*R 


C=1.0/R 
S=S*C 
G = D(I+1) - P 
R= 
P=S*R 
D(I+1) =G+P 
G=C*R-B 

CONTINUE 

D(L) = D(L) - P 

E(L) = G 

E(M) = 06.0 

GO TO 145 


KREKKEREKK ORDER EIGENVALUES *XXRRAKEKK 
IF (L .EQ. 1) GO TO 25¢ 
RKRKKKEKKKEK FOR I=L STEP -1 UNTIL 2 DO —— #kERRKKKERK 


DO 23¢ 


Wee ee ae ee 
IF (P .GE. D{I-1)) GO TO 270 


D(T) 
CONTINU 


T=1 
DCI) = 
CONTINUE 


GO TO 1661 


RRKKERKKKK SET ERROR -- NO CONVERGENCE TO AN 
EIGENVALUE AFTER 30 ITERATIONS **kkkkdeKK 


TERR = L 
RETURN 


HEAAKAKAKK LAST CARD OF IMTQL1 *kxkkKAAKK 


END 


F/G 


(D(I) -G) *S+2.0* C*B 


Il = 2, L 


= D(I-1) 
E 


P 


$6602930 
06002946 
00902950 
660062966 
00002970 
00602980 
00002990 
00003000 
00003010 
6600630626 
90003030 
60003646 
$066030656 
06003060 
000603070 
90003080 
900030690 
00063100 
60903110 
$0006312¢ 
909063130 
06003140 
66003156 
06003160 
00003176 
066063180 
$60603190 
000603206 
66603210 
60603226 
$0003230 
$60603240 
000603250 
$9003266 
00003270 
06003280 
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ALGORITHM 538 

Eigenvectors and Eigenvalues of Real 
Generalized Symmetric Matrices 

by Simultaneous Iteration [F2] 


PAUL J. NIKOLAI 
U.S. Air Force Flight Dynamics Laboratory 


Key Words: and Phrases: eigenvalue, eigenvector, sparse matrix, diagonable matrix, simultaneous 
iteration, Fortran program 

CR Categories: 4.6, 5.14 

Language: Fortran 


DESCRIPTION 


The program presented here is an implementation of the simultaneous iteration 
algorithm [2] for calculating the eigenvalues largest in magnitude and correspond- 
ing eigenvectors of a real matrix symmetric relative to a prescribed inner product. 
Let ip(n, w, z) denote an inner product in the space of real column n-tuples and 
let the real n-square matrix C satisfy ip(n, Cw, z) = ip(n, w, Cz). Then C is 
symmetric relative to ip, and if the n-square positive definite matrix B satisfies 
ip(n, w, z) = w' Bz then C is B-symmetric. The equation BC = C’B characterizes 
the B-symmetry of C. Given an optional set of p initial approximate eigenvectors 
of a real n-square B-symmetric matrix C corresponding to p eigenvalues of C 
largest in magnitude, the program calculates em eigenvalues and em correspond- 
ing eigenvectors, 0 S em < p =n, to a precision dependent on the structure of C 
and on a prescribed tolerance eps. The matrix B is presented to the program as 
an independently prepared real function subprogram which calculates ip(n, w, z) 
= w' Bz given column n-vectors w and z. The matrix C is presented as an 
independently prepared subroutine subprogram op(n, z, w) which when given an 
n-vector z computes its image w = Cz. The program is an outgrowth of a literal 
Fortran translation [5] of the Algol procedure ritzit [8] to which it is substantially 
equivalent when C = C" and ip(n, w, z) = w'z, the standard inner product. But 
depending on the choice of B and C, the present program enables the direct 
treatment of a wide variety of symmetric eigenproblems. 

Let A = A‘ and B = B” denote n-square real matrices and let o be real. If B 
is positive definite then the matrix C = B~'(A — oB) is B-symmetric, and the 
program computes eigenvalues farthest from o of the eigenproblem Au = ABu 
and corresponding eigenvectors. Implementation of op(n, z, w) here consists in 
providing for the appropriate solution for w of the linear system Bw = (A — oB)z. 
Alternatively, selection of op to solve the system (A — oB)w = Bz for w enables 
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the calculation by simultaneous inverse iteration of the eigenvalues nearest to o 
and their eigenvectors. Implications for large sparse systems for which the 
Cholesky factorization [6] of B is impractical are clear. The user may wish to 
supplement the following outline of the operation of the program by consulting 
the description of the Algol procedure ritzit in [8] or [10] as well as a review of 
the mathematical foundations of simultaneous iteration in [4] and [7]. 


Let the eigenvalues di, ..., dp, dpi, ..., dn of C be arranged in order of 
descending absolute value and let KE, denote the direct sum of the distinct 
eigenspaces corresponding to di, ..., dp». Let Xo denote an n-by-p matrix having 


a p-dimensional column space not orthogonal relative to ip to any eigenvector in 
E,. Simultaneous iteration is based on the observation that if | d,| > | dp4i|, the 
columns of the matrix X41 = C”X; tend to a basis of E,, as ks = k + m increases, 
But in practice all of the columns of X;;, tend toward the eigenspace EF) causing 
loss of information concerning the residual eigenvectors. To counter this ten- 
dency, set 


Xrem = C"X, Ritm (1) 


where the p-square upper triangular matrix R;, is constructed together with X;; 
by the Gram-Schmidt process to render the columns of X;; orthonormal relative 
to ip. Now the ith column vector of X;, converges to the 7th eigenvector of C at 
a rate proportional to maxosi<p (| di/di-1|, | di+i/di|). Clearly this convergence will 
be delayed in the presence of eigenvalue clustering. But if | d, |/| dp+i| is not too 
small, the column space of X;, will contain a good approximation to the ith 
eigenvector even when ks is small. 

In order to recover this approximation, a modified Rayleigh-Ritz process is 
employed. Let Q:, denote an orthogonal matrix which diagonalizes the p-square 
symmetric matrix R;,R2;. Then the ith column vector of 


Xp+1 = CX, Riss Qr+1 (2) 


converges to the ith eigenvector of C at a rate proportional to | d,+1/di| while the 
entries of the diagonal matrix computed with Q,, and properly ordered offer close 
approximations to d,’,..., d,’. The true signed eigenvalues need only be com- 
puted at termination by diagonalizing the leading (p ~ 1)-square principal 
submatrix of Xi; BCX;s, the eigenproblem for C projected on E,_, relative to ip. 

The program determines a strategy for employing the devices (1) and (2) based 
on the distribution of the leading p eigenvalues of C upon which the convergence 
rate ultimately depends. The selection of values m in eq. (1) is particularly 
important in this regard in that C”X, is replaced by the mth Chebychev 
polynomial on the interval [—e, e] evaluated by a special three-term recurrence 
relation and permitting accelerated convergence when values of m are continually 
large; e is the current value of d,. As a result the convergence quotient lies 
between | d,;/dem| and exp(—are cosh | dem/dp|). It is nearer to the first value if 
| d:/dem| is large and nearer to the second if the latter quotient is close to 1. 

As the iteration proceeds through a maximum of | km.| iteration steps (km is a 
program parameter), acceptance tests for the eigenvalues and eigenvectors are 
conducted following each of the Rayleigh-Ritz steps (2). As soon as the relative 
increase of | dj+:| is smaller than eps/10, then dj+; is accepted and A, the number 
of previously accepted eigenvalues, is increased by 1. Kigenvectors are accepted 
in groups of one or more corresponding to clusters of accepted eigenvalues nearly 
equal in magnitude. If g eigenvectors have already been accepted, let dg1i,..., di 
denote such a cluster. For all 7, g + 13/7 S J, denote by y; the projection relative 
to ip of the image Cx; of the ¢th column x; of X;, on the linear closure of x,,..., 
x, Set f; = max; || Cx; — y,||/|| Cx; || for 7 = g + 1,..., 7 where the indicated norm is 
the Euclidean norm or 2-norm relative to ip. If | d:| fi/(|d:| — e) is smaller than 
eps then all the x;,7=g+1,...,/, are accepted as eigenvectors and g is increased 
to l. The error quantities f; are systematically discounted in accordance with the 
convergence properties of the algorithm to permit convergence in the presence of 
excessive roundoff error or in case the parameter eps is prescribed unrealistically 
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small. Having determined g eigenvectors, the iteration continues with p — g 
remaining columns of X;, until either em eigenvectors have been calcuated or 
|km| has been exceeded. The program may reduce em if it detects either no 
progress in convergence of eigenvectors corresponding to smaller eigenvalues or 
lack of stability in the behavior of larger eigenvalues. 

We list the principal differences between ritzit and the program given here. 

(1) The procedure inprod for calculating standard inner products was removed 
and the procedure ip was introduced where appropriate. 

(2) The procedure jacobi for calculating the solutions of the eigenproblem for 
(p — g)-square and (p — 1)-square symmetric matrices was replaced by calls to 
the EISPACK [9] subroutines TRED2 and IMTQL2, primarily to save space. 

(3) The procedure random for calculating random column n-vectors of the 
matrix X;; was replaced by in-line code which references a Fortran function 
RANF. RANF returns uniformly distributed random REAL values from the 
interval (0, 1), one per function reference, given any one argument of any type. It 
is provided by the user. 

(4) The procedure orthog to perform Gram-Schmidt orthogonalization of the 
columns of X;, was replaced by internally linked in-line code. In attempting to 
control potential underflow within orthog in a machine independent fashion, 
ritzit calculates the machine precision mc but assumes in usage that out-of-range 
values underflow gracefully to zero, a machine dependent characteristic. The 
present program utilizes a single REAL machine dependent constant MT, the 
ratio of the smallest Fortran representable positive value to the machine precision, 
to test for this condition and upon its detection to take appropriate measures. 

(5) In its Algol implementation ritzit requires approximately (p + 3)n + 2p’ 
+ 5p storage locations in excess of those required by the program. Economies 
resulting in part from (2) above [38] have reduced this requirement to (p + 2)n 
+ p” + 4p in the program presented here. All working storage is confined to a 
single array of 2n + p” + 3p locations. 

(6) The value of km as an input parameter, set to |km| during program 
execution, is finally replaced by the value of ks as an output parameter, the 
number of iteration steps used in the calculation of em eigenvectors. 

(7) The program given here retains unchanged the reference to a user supplied 
procedure inf as a window on program execution. However, the one variable 
involving eps is periodically redefined to enable effect control of eps from inf or 
from ip or op should this prove desirable. 

The testing procedures developed for the present Fortran program parallel its 
evolution from a research tool, which conformed closely to its Algol parent, to 
present form. Early testing was concentrated on duplicating the tests furnished 
with ritzit and in eliminating errors in interpretation and translation of the Algol 
code. This was done for the most part on the CDC 6600 using Fortran Extended, 
Version 3, under the SCOPE 3.3 operating system. Upon completion of this first 
phase, the resulting program was distributed as SUBROUTINE RITZIT with a 
locally developed library of Fortran linear algebra routines [5]. This same program 
served as a basis of ritzit translations for IBM 360/370 processors [1, 3] whose 
preparation uncovered several bugs in the RITZIT code and suggested worthwhile 
modifications. A second phase of testing involved the development of a package 
of auxiliary Fortran programs for use with SUBROUTINE RITZIT to solve the 
eigenvalue problem Au = A Bu through methods depending on Cholesky factori- 
zation where A and B may either be full matrices or sparse and banded. This 
phase was conducted on the CDC 6600 using Fortran Extended, Version 4, under 
SCOPE 3.4. 

Systematic testing of the present program, SUBROUTINE SIMITZ, has been 
accomplished in part with the aid of driver program TESTB which generates a 
symmetric band matrix A and a lower triangular band matrix T of prescribed 
order n and bandwidths whose relevant entries are randomly generated integer 
values from a prescribed interval. The band matrix B is TT’, and the program 
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calculates the maximal eigenvalues of Au = A Bu. For the sequence of values of 
Dp, p = 2,..., min([n/5], 10), TESTB exercises SIMITZ for successive values of 
em, em = 1,...,p — 1. For each value of i, 1 = 1,..., em, TESTB computes the 
residuals Ax; — d:Bx; and their Euclidean norms relative to the standard inner 
product. Each norm is normalized by the difference | d;| — e, and for each value 
of em the quantity maxisizem || Ax; — d:Bx;i||/(| d:| — e), the value & of 1 for which 
the maximum occurs, and the corresponding geometric mean with unit weights 
are listed. Also listed are the relevant nonzero diagonals of A and T and the final 
eigenvalues computed for em = p — 1. 

Figure 1 shows an output listing from the executable program TESTB on the 
CDC 6600 under the NOS/BE operating system and Fortran Extended, Version 
4. Here A and B are of order 30 and each of bandwidth 7 having relevant entries 
between —99 and +99. Listed are the main diagonal and the three adjacent lower 
diagonals of T and A beginning with the entries in the first column. Here eps = 
10-*° and km = 100. Note how the relative nearness in magnitude of the first 
three eigenvalues inhibits the convergence of the second eigenvector when p = 3 
and em = 2 resulting in acceptance of the first eigenvector only. The fourth 
eigenvalue, however, is in absolute value far enough away from this cluster to 
permit successful convergence when p = 4 and em = 1, 2, and 3. This phenomenon 
points to a procedure for pursuing a solution when p is initially chosen too small. 
SIMITZ may be reentered with X containing the approximate eigenvectors 
calculated for the smaller value of p as initial approximations for use with p 
increased in size. Significant processor time may often be saved in this fashion. 


ADJACENT NON-ZERO LOWER DIAGONALS OF T, TI’ = B 


53 86 78 60 85 99 73 64 80 88 93 93 57 52 83 
74 99 88 87 52 64 86 95 66 86 55 95 61 76 70 
-26 22 49 65 -30 38 82 -9 -87 56 18 95 93 -46 -31 
1 90 -44 75 -6 -49 99 90 -62 16 2 -40 -67 14 
-25 6 54 32 -73 -35 ~1 -46 6 -13 -77 77 -51 -85 31 
“24 88 -66 -18 -41 5 80 74 -80 -2 -6 78 -97 
-76 19 -26 =5 97 70 6 -95 45 -30 -12 -65 -92 9 39 
97 -19 26 86 -48 -52 -31 49 -8 ~85 5 20 


ADJACENT NON-ZERO LOWER DIAGONALS OF A = A’ 


-3 50 -55 -73 -47 88 -33 -28 -77 ~40 96 78 9 -54 -39 

10 95 -53 -80 0 52 44 0 ~50 -94 -22 29 -36 <4 36 
0 65 59 -29 -84 -4 4l -90 72 -65 74 36 82 -86 -5 

22 56 94 9 -47 84 -97 -1 57 -22 -1 -55 -15 51 

62 5 ~41 -95 -47 -91 14 84 -83 69 43 -27 61 79 14 

21 85 -5 -61 -16 -15 90 ~44 -22 -66 50 —34 -97 

-17 94 78 -95 -89 -31 -43 52 64 -70 71 95 -69 ~-12 87 

91 -93 6 39 66 32 -20 92 -11 0 -98 ~12 
P EM CIN) EM (OUT ) KS K MAX RESIDUAL MEAN RESIDUAL TIME (SECS ) 
2 1 1 30 1 3.70E-11 3 .70E-11 242 
3 1 1 26 1 2.81E-11 2 .81E-11 -62 
3 2 1 56 1 3 .00E-11 3 .00E-11 1.00 
4 i 1 15 1 2.17E-11 2.17E=11 -69 
4 2 2 15 2 2.01E-11 1.81E-11 -69 
4 3 3 24 3 2 .53E-11 2 -09E-11 «92 
5 1 1 13 1 2.20E-11 2.20E-11 1.02 
5 2 2 13 1 2-03E-11 1 .99E-11 1.03 
5 3 3 13 1 2.24E-11 1 .60E-11 1.01 
5 4 4 33 1 2.37E-11 6 -67E=-12 1.44 
6 1 1 13 1 2-09E-11 2 -09E-11 1.36 
6 2 2 13 2 2.16E-11 2-04E-11 1.36 
6 3 3 13 2 2 .89E-11 2 .03E-11 1 -33 
6 4 4 21 4 2 -02E-10 3 .63E-11 1.76 
6 5 4 31 1 2.64E-11 1 -O9E-11 2.10 


FINAL EIGENVALUES 


2.393019487013EHW0 -1.245936323012E+00 1.188248083996E+100 9 -2.273759446561E-01 -9.705562962258E-02 


Fig. 1 
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ALGORITHM 
SUBROUTINE SIMITZ(N, P, KM, EPS, IP, OP, INF, EM, X, MN, D, WR) 10 
COME aE III IRI II IORI OR TA A 20 
C IDENTIFICATION 30 
C SIMITZ - ITERATIVE COMPUTATION OF EIGENVALUES LARGEST IN MAGNI- 40 
Cc TUDE AND CORRESPONDING EIGENVECTORS OF A REAL GENERAL- 50 
Cc IZED SYMMETRIC MATRIX 60 
C FORTRAN SUBROUTINE SUBPROGRAM 70 
Cc US AIR FORCE FLIGHT DYNAMICS LABORATORY 80 
Cc WRIGHT-PATTERSON AFB, OHIO 45433 90 
C PURPOSE 100 
C A REAL N-SQUARE MATRIX C Is B-SYMMETRIC RELATIVE TO AN N-SQUARE 110 
Cc POSITIVE DEFINITE MATRIX B IN CASE BC = (C-TRANSPOSED)B. 120 
Cc GIVEN AS OPTIONAL INPUT A ISET OF P INITIAL APPROXIMATE 130 
Cc EIGENVECTORS OF A REAL N-SQUARE B-SYMMETRIC MATRIX C CORRES- 140 
Cc PONDING TO P EIGENVALUES OF C LARGEST IN MAGNITUDE, SIMITZ COM- 150 
Cc PUTES EM EIGENVALUES AND EM CORRESPONDING EIGENVECTORS TO A 160 
Cc PRECISION DEPENDENT ON THE. STRUCTURE OF B AND C AND ON A GIVEN 170 
C TOLERANCE EPS. THE MATRIX B IS PRESENTED TO SIMITZ AS AN ALGO- 180 
Cc RITHM FOR CALCULATING THE STANDARD INNER PRODUCT (W, BZ) = 190 
Cc (W-TRANSPOSED)BZ GIVEN COLUMN N-VECTORS W AND Z IMPLEMENTED AS 200 
C A FORTRAN COMPATIBLE REAL FUNCTION SUBPROGRAM. THE MATRIX C IS 210 
Cc PRESENTED AS A SUBROUTINE SUBPROGRAM WHICH GIVEN A COLUMN 220 
C N-VECTOR Z CALCULATES ITS IMAGE W = CZ UNDER THE MATRIX C. 230 
C DEPENDING ON THE CHOICE OF B AND C, SIMITZ APPLIES TO A WIDE 240 
Cc VARIETY OF SYMMETRIC EIGENPROBLEMS. 250 
C CONTROL 260 
C 270 
Cc DIMENSION X(MN,P), D(P), WK(K) 280 
Cc INTEGER P, EM 290 
Cc REAL IP 300 
Cc EXTERNAL IP, INF, OP 310 
C - 320 
C 7 330 
Cc : 340 
Cc CALL SIMITZ(N, P, KM, EPS, IP, OP, INF, EM, X, MN, D, WK) 350 
C 360 
C WHERE 370 
C N IS AN INTEGER INPUT VARIABLE, THE ORDER OF THE MATRIX C. 380 
C P IS AN INTEGER INPUT VARIABLE, THE NUMBER OF SIMULTANEOUS 390 
Cc ITERATION VECTORS. ; 400 
Cc KM AS AN INTEGER INPUT VARIABLE IS IN MAGNITUDE THE MAXIMUM 410 
Cc NUMBER OF ITERATION STEPS TO BE EXECUTED. IF KM IDENTIFIES 420 
Cc A NEGATIVE VALUE THEN P INITIAL APPROXIMATE EIGENVECTORS 430 
Cc ARE ASSUMED TO BE PRHSENT IN THE ARRAY X. OTHERWISE SIMITZ 440 
Cc SUPPLIES RANDOM INITIAL EIGENVECTORS. 450 
Cc KM AS AN INTEGER OUTPUT VARIABLE IDENTIFIES THE NUMBER KS OF 460 
Cc ITERATION STEPS FINALLY USED IN THE CALCULATION OF EM 470 
Cc EIGENVECTORS. 480 
C EPS IS A REAL INPUT VARIABLE, THE TOLERANCE FOR ACCEPTING 490 
Cc EIGENVECTORS. AS SOON AS SUCCESSIVE ITERATES OF THE RITZ 500 


538-P 5-0 


COLLECTED ALGORITHMS (cont.) 


QPAQAAAAIAANAAAAAAARAANAAAAANAAANAANAANAANNANAAANANANAGAANAANANAANNANAANKMGAAnAANnAAAAAMAAaGa4G 


VALUES ABS(D(H+1)) DIFFER BY LESS THAN ABS(D(H+1))*EPS/10.0 
THEN D(H+1) IS ACCEPTED AS AN EIGENVALUE AND H, THE NUMBER 
OF PREVIOUSLY ACCEPTED EIGENVALUES, IS INCREASED BY 1. AS 
SOON AS THE ERROR QUANTITIES F(I), NORMALIZED RESIDUALS, 
SATISFY D(I)*F(I)/(D(I) - D(P)) .LT. EPS, THEN G, THE NUM- 
BER OF ALREADY ACCEPTED RITZ VECTORS, IS INCREASED TO 
G+L, l=G+1,..., L. THE F(I) ARE DISCOUNTED WITH 
SUCCESSIVE ITERATIONS TO FORCE CONVERGENCE IN CASE OF UN- 
FORTUNATE CHOICE OF PARAMETERS. IF M SIGNIFICANT DIGITS 
OF ACCURACY ARE REQUIRED OF THE EIGENVALUES, THEN SET 

EPS EQUAL TO 10.0**(-M) AS A GENERAL RULE. 

IP IS AN EXTERNAL INPUT VARIABLE, THE NAME OF A FORTRAN COM- 
PATIBLE REAL FUNCTION SUBPROGRAM OF THE FORM IP(N, Z, W) 
WHICH MUST RETURN THE INNER PRODUCT (W, BZ) = 
(W-TRANSPOSED) BZ OF THE VECTORS IDENTIFIED BY THE N-ARRAYS 
Z AND W RELATIVE TO THE POSITIVE DEFINITE MATRIX B. 

OP IS AN EXTERNAL INPUT VARIABLE, THE NAME OF A FORTRAN COM- 
PATIBLE SUBROUTINE SUBPROGRAM OF THE FORM OP(N, Z, W) 
WHICH MUST CALCULATE THE IMAGE W OF THE VECTOR IDENTIFIED 
BY THE N-ARRAY Z UNDER THE N-SQUARE MATRIX C WITHOUT OVER- 
WRITING Z. 

INF IS AN EXTERNAL INPUT VARIABLE, THE NAME OF A FORTRAN COM- 
PATIBLE SUBROUTINE SUBPROGRAM WHICH MAY BE USED FOR 
OBTAINING INFORMATION OR TO EXERT CONTROL DURING EXECUTION 
OF SIMITZ. INF HAS THE FORM INF(KS, G, H, F) WHERE 

KS IS AN INTEGER OUTPUT VARIABLE, THE NUMBER OF THE NEXT 
ITERATION STEP. 

G IS AN INTEGER OUTPUT VARIABLE, THE NUMBER OF ALREADY 
ACCEPTED EIGENVECTORS. 

H IS AN INTEGER OUTPUT VARIABLE, THE NUMBER OF ALREADY 
ACCEPTED EIGENVALUES. 

F IS A REAL OUTPUT VARIABLE P-ARRAY, ERROR QUANTITIES 
MEASURING RESPECTIVELY THE STATE OF CONVERGENCE OF 
THE P SIMULTANEOUS ITERATION VECTORS. IN ADDITION, 
IF CONVERGENCE FAILS IN SUBROUTINE IMTQL2 AFTER G 
EIGENVECTORS HAVE BEEN ACCEPTED, THEN F(G+1) IS RE- 
PLACED BY 1000.*FLOAT(IERR) WHERE IER IS THE ERROR 
INDICATOR OUTPUT BY IMTQL2. EACH ELEMENT OF THE ARRAY 
F IS INITIALLY SET BY SIMITZ TO THE VALUE 4.0. 

EM AS AN INTEGER INPUT VARIABLE IS THE NUMBER OF EIGENVALUES 
TO BE COMPUTED, 0 .LT. EM .LT. P .LE. N .LE. MN. 

EM AS AN INTEGER OUTPUT VARIABLE IS THE NUMBER OF EIGENVECTORS 
COMPUTED THROUGH KM ITERATION STEPS. 

X AS A REAL N-BY-P INPUT ARRAY IS A SET OF P OPTIONAL INITIAL 
APPROXIMATE EIGENVECTORS X(I,1), ..., X(I,P), L=1, ..-, 
N, INTERPRETED BY SIMITZ IF KM IS NEGATIVE. 

X AS A REAL N-BY-P OUTPUT ARRAY IS A SET OF EM EIGENVECTORS 
X(I,1), ..., X(1,EM), IT = 1, ..., N, COMPUTED THROUGH 
TABS (KM) ITERATION STEPS WITH THE REMAINDER OF X CONSISTING 
OF P - EM APPROXIMATE EIGENVECTORS. THE N-BY-P MATRIX X 
SATISFIES (X-TRANSPOSED)BX = I, THAT IS, THE EIGENVECTORS 
OF C ARE B-ORTHONORMAL. 

MN IS AN INTEGER INPUT VARIABLE WHICH IDENTIFIES THE LEADING 
DIMENSION IN THE CALLING PROGRAM OF THE ARRAY X. 

D IS A REAL OUTPUT P-ARRAY OF WHICH D(1), ..., D(EM) ARE THE 
EIGENVALUES OF C LARGEST IN MAGNITUDE IN DECREASING ORDER 
CORRESPONDING TO THE COMPUTED EIGENVECTORS X(I,1), ..., 
X(1,EM), I= 1, ..., N. D(EM+t1L), ..., D(P-1) CONTAIN 
APPROXIMATIONS TO PROGRESSIVELY SMALLER SUCH EIGENVALUES. 
D(P) CONTAINS THE MOST RECENTLY COMPUTED VALUE OF E, WHERE 
THE INTERVAL (-E, E) IS THE INTERVAL OVER WHICH THE 
CHEBYSHEV ACCELERATION WAS PERFORMED. 

WK THE INITIAL LOCATION OF AT LEAST P**2 + 3*P + 24N = K 
CONSECUTIVE STORAGE LOCATIONS WHICH MAY NOT BE OVER- 
WRITTEN WHILE SIMITZ IS IN EXECUTION. 

OTHER PROGRAMMING INFORMATION 

SIMITZ EMPLOYS A DATA STATEMENT TO ASSIGN TO A MACHINE DEPEN- 

DENT REAL VARIABLE MI THE QUOTIENT OF THE SMALLEST POSITIVE 

REAL VALUE REPRESENTABLE BY FORTRAN AND THE SMALLEST REAL VALUE 

WHOSE SUM WITH 1.0 EXCEEDS 1.0. 


THE PERFORMANCE OF SIMITZ IS STRONGLY DEPENDENT UPON THE CHOICE 
OF INPUT PARAMETERS AND UPON THE CAREFUL PREPARATION OF THE 
SUBPROGRAMS IP AND OP. THE USER SHOULD CONSIDER USING HIS OWN 
ACTIVE SUBROUTINE INF TO MONITOR PROGRESS OF SIMITZ RELATIVE TO 
HIS CHOICE OF INPUT PARAMETERS IF NO INFORMATION IS OTHERWISE 
AVAILABLE CONCERNING THE LOCATIONS OF THE RELEVANT EIGENVALUES. 
RECALL THAT SIMITZ MAY BE REENTERED WITH KM .LT. 0 WITHOUT LOSS 
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OF INFORMATION TO PERMIT CONSERVATIVE INITIAL CHOICES OF 
ABS(KM), EPS AND P. 


OTHER PROGRAMS REQUIRED 


FUNCTION RANF 
RETURNS UNIFORMLY DISTRIBUTED RANDOM NUMBERS ON THE OPEN 
INTERVAL (0, 1) GIVEN ANY ONE ARGUMENT OF ANY TYPE. 
SUBROUTINE TRED2 
IS THE EISPACK (4) PROGRAM WHICH COMPUTES A HOUSEHOLDER 
TRIDIAGONAL FORM OF A REAL SYMMETRIC MATRIX. 
SUBROUTINE IMTQL2 
IS THE EISPACK PROGRAM WHICH COMPUTES THE EIGENVALUES AND 
ORTHONORMAL EIGENVECTORS OF A SYMMETRIC TRIDIAGONAL MATRIX. 
FUNCTION IP 
IS DESCRIBED ABOVE. 
SUBROUTINE OP 
IS DESCRIBED ABOVE. 
SUBROUTINE INF 
IS DESCRIBED ABOVE. 


METHOD 


SIMITZ REPRESENTS RESULTS OF EXTENSIVE MODIFICATIONS AND TESTS 
OF SUBROUTINE RITZIT (1), AN ANSI FORTRAN TRANSLATION OF THE 
ALGOL 60 PROCEDURE OF THE SAME NAME (3). THE BASIC RUTISHAUSER 
-REINSCH ALGORITHM IS PRESERVED. 


REFERENCES 


(1) PAUL J. NIKOLAI AND NAI-KUAN TSAO, THE ARL LINEAR ALGEBRA 
LIBRARY HANDBOOK, ARL TR 74-0106, AEROSPACE RESEARCH LABOR- 
ATORIES, WRIGHT-PATTERSON AFB, OHIO, 1974. 

(2) HEINZ RUTISHAUSER, COMPUTATIONAL ASPECTS OF F.L. BAUER S 
SIMULTANEOUS ITERATION METHOD, NUMER. MATH. 13(1969), 4-13. 

(3) ----------------- » SIMULTANEOUS ITERATION METHOD FOR SYM- 
METRIC MATRICES, NUMER. MATH. 16(1970), 205-223. 

(4) B.T. SMITH ET AL, MATRIX EIGENSYSTEM ROUTINES-EISPACK 

GUIDE, LECTURE NOTES IN COMPUTER SCIENCE 6, SPRINGER-VERLAG 
NEW YORK, 1974. 


PLEASE REFER QUESTIONS, COMMENTS OR SUGGESTIONS TO 


PAUL J. NIKOLAI 
AFFDL/FBR 

WRIGHT-PATTERSON AFB, OH 45433 
(513)-255-5350@ 
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EXTERNAL INF, IP, OP 

INTEGER EM, G; H, i iG; IK, a 
* JK, JP, K, KM, KS, a LF, 
x La. M, MN, M1, N, Be zl, 
* yA 

LOGICAL ORIG 

REAL Dy E, EPS, El, E2, IP, MT, 
x S T, WK X 


> > 
DIMENSION X(MN,1), D(1), WK(P,P,1) 


DATA MT /.220360641585062E-279/ 


THE LOCAL VARIABLE ARRAYS FROM (3) ARE ASSIGNED TO THE 
VARIABLE ARRAY WK AS FOLLOWS 


WK(I,J,1) = B(I,J), I, J=1, ..., P. 
WK(I,1,2) = CX(I), IT=1, ..., P. 
WK(I,2,2) = F(I), IT = 1, ..., P. 
WK(I,3,2) = RQ(I), T= 1, «+0, P. 
WK(T, 4,2) = U(T), I = 1, sec, Ne 
WK(I4N,4,2) = W(I), IT = 1, ..., N. 


NOT NEEDED ARE V(I), I = 1, ..-, N, R(I), T=1, ... 
Q(I,J), I, J = L, eeryg P. 


THE NEXT STATEMENT IS START. 


= 1 


WK(P,1,2) = .@EtOO 


1290 
1300 
1310 
1320 
1330 
1340 
1350 
1360 
1370 
1380 
1390 
1400 
1410 
1420 
1430 
1440 
1450 
1460 
1470 
1480 
1490 
1500 
1510 
1520 
1530 
1540 
1550 
1560 
1570 
1580 
1590 
1600 
1610 
1620 
1630 
1640 
165¢ 
166¢ 
1676 
1680 
1690 
1700 
1710 
172¢ 
1730 
1740 
1759 
1760 
1770 
178¢ 
1796 
1800 


181¢ 
1820 


1830 
1846 
1850 
1860 
1870 
1880 
1890 
19060 
1910 
192¢ 
1930 
1946 
1950 
1960 
1970 
198¢ 
199¢ 
2000 
2016 
2020 
2030 
2040 
2050 
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15¢ 


16¢ 


170 
180 


196 


aa 


pO 1¢ L=1, P 
WK(L,2,2) = .4E+#1 
WK(L, 3, 2) = - GE+OO 
CONTINUE 
IF (KM) 5@, 506, 2¢ 
DO 46 L= 1, P 
DO 36 J=1,N 
X(J,L) = .2E+O1*RANF(.2E+@1) - .1E+@1 
CONTINUE 
CONTINUE 
KM = LABS (KM) 
ASSIGN 6@ TO IK 
LF = IG 
Ll = P 
GO TO 99¢ 
RAYLEIGH-RITZ STEP 
STATEMENT 6@ IS LOOP. 
DO 8@ K = IG, P 
CALL OP(N, X(1,K), WK(1,4,2)) 
DO 74 J=1,N 
X(J,K) = WK(J,4,2) 
CONTINUE 
CONTINUE 
ASSIGN 9@ TO IK 
LF = IG 
Ll = P 
GO TO 99¢ 
IF (KS) 15¢, 100, 150 
MEASURES AGAINST UNHAPPY CHOICE OF INITIAL VECTORS 
DO 136 K = 1, P 
IF (WK(K,K,1)) 136, 116, 130 
DO 126 IT =1,N 
X(I,K) = .2E+@1*RANF(.2E+01) - .1E+O1 
CONTINUE 
KS = 1 
CONTINUE 
IF (KS - 1) 15@, 140, 15¢ 
ASSIGN 6@ TO IK 
LF = 1 
Ll = P 
GO TO 99¢ 
DO 18¢ K = IG, P 
DO 176 L = K, P 
S = .GE+0¢ 
DO 16¢ IT = L, P 
S = S + WK(I,K,1)*WK(I,L,1) 
CONTINUE 
WK(L,K,1) = -S 
CONTINUE 
CONTINUE 


CALL TRED2(P, P - G, WK(IG,IG,1), D(IG), WK(1,4,2), WK(IG,IG,1)) 
CALL IMTQL2(P, P - G, D(IG), WK(1,4,2), WK(IG,IG,1), L) 
(IG,2,2) = AMAX1(WK(IG,2,2), .1lE+$4*FLOAT(L)) 


WK 
DO 


199 K = IG, P 


D(K) = SQRT(AMAX1(-D(K), .@E+00)) 
CONTINUE 


DO 


REORDERING EIGENVALUES AND EIGENVECTORS ACCORDING TO SIZE OF 
THE FORMER IS ACCOMPLISHED IN SUBROUTINE IMTQL2. 


236 J=1, N 


DO 216 K = IG, P 


S = .GE+hO 
DO 20@ L = IG, P 
S = S + X(J,L)*WK(L,K,1) 
CONTINUE 
WK(K,4,2) = S$ 
CONTINUE 


DO 226 K = IG, P 


X(J,K) = WK(K,4,2) 
CONTINUE 


CONTINUE 


KS 


= KS + 1 


E = AMAXI(D(P), E) 


IF 
DO 


X(J,P) 


RANDOMIZATION 
"(3 - Z1) 266, 240, 24¢ 
259 J=1, N 
= ,2E+Q@1*RANF(.2E+91) - .1E+61 


2060 
2070 
2680 
2090 
2106 
2110 
2120 
213 
2140 
2150 
2160 
2176 
2186 
2190 
2200 
221¢ 
2226 
2230 
2240 
2250 
2260 
2270 
2280 
2296 
2300 
2310 
2320 
2330 
234 
2350 
2360 
2370 
2380 
2390 
24h0 
2410 
2420 
2430 
2440 
2450 
2460 
2470 
2480 
2490 
2500 
2516 
252 
2530 
2540 
2550 
2560 
2570 
2580 
2590 
2600 
2610 
2620 
263¢ 
2640 
2650 
2660 
2670 
2680 
2690 
2700 
271 
2720 
2730 
2740 
275 
276 
2770 
2780 
2790 
2800 
2810 
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250 


Aaa 


560 


510 


520 


53¢ 


540 


CONTINUE 
JP=P-1 
ASSIGN 26@ TO IK 
LF = P 
Ll =P 
GO TO 99¢ 
COMPUTE CONTROL QUANTITIES CX(I). 

DO 316 K = 1G, JP 

S = (D(K) - E)*(D(K) + E) 

IF (S) 276, 276, 280 

WK(K,1,2) = .GE+OO 

GO TO 316 

IF (E) 3066, 290, 300 

WK(K,1,2) = .1E+@4 + ALOG(D(K)) 

GO TO 316 

WK(K,1,2) = ALOG((D(K) + SQRT(S))/E) 
CONTINUE 


ACCEPTANCE TEST FOR EIGENVALUES INCLUDING ADJUSTMENT OF EM AND 
H SUCH THAT D(EM) .GT. E, D(H) .GT. E AND D(EM) DOES NOT 


OSCILLATE STRONGLY 

zl - 1 

G 
=K+1 

IF (EM - K) 376, 336, 330 

IF (D(K) ~ E) 3606, 360, 346 

IF (1) 32@, 320, 35¢ 

IF (D(K) - .999E+¢@*WK(K,3,2)) 360, 360, 326 
CONTINUE 
EM =K- 1 

STATEMENT 370 IS EX4. 

IF (EM) 386, 11306, 380 


AA 
ofl 


K =H 
S = .1E+)1 + .1E+SO*EPS 
Koesk ed 


IF (D(K)) 40646, 416, 46¢ 
IF (D(K) - S*WK(K,3,2)) 396, 390, 410 


CONTINUE 

H=K-1 
K = EM 
K=K+1 


IF (K - H) 436, 430, 450 
IF (D(K) - E) 446, 444, 426 
CONTINUE 
H=K-1 
ACCEPTANCE TEST FOR EIGENVECTORS 
L=G 
E2 = .QE+066 
DO 59@ K = IG, JP 
IF (K - (L + 1)) 516, 466, 510 
CHECK FOR NESTED EIGENVALUES 


L=K 
Li = kK 

S = .5E+$@/FLOAT(KS) 

T = .1E+01/FLOAT(KS*M) 
L=L+1 


IF (L - JP) 486, 486, 490 


IF (WK(L,1,2)*(WK(L,1,2) + S) + T - WK(L-1,1,2)*WK(L-1,1,2)) 


496, 4946, 476 
CONTINUE 
L=L-1 

THE NEXT STATEMENT IS EX5. 

IF (L - H) 510, 516, 500 
L=L1-1 
GO TO 66¢ 
CALL OP(N, X(1,K), WK(1,4, 2)) 
S = .@E+OO 
DO 5406 J = 1, L 


IF (ABS(D(J) - D(K)) - .1E-@1*D(K)) 520, 546, 54@ 


T = IP(N, WK(1,4,2), X(1,J)) 
DO 536 T=1, N 
WK(1,4,2) = WK(1I,4,2) - T*X(1I,J) 
CONTINUE 
S = $ + TAT 
CONTINUE 
T= .1E+¢1 
IF (S .NE. .GE+@O) T = IP(N, WK(1,4,2), WK(1,4,2)) 


2820 
2830 
2840 
2850 
2860 
2870 
2880 
2890 
2900 
291¢ 
2920 
2930 
2940 
2950 
2960 
2970 
2980 
2990 
3000 
3010 
3020 
3030 
3040 
3050 
3060 
3070 
3080 
3090 
3100 
3110 
312¢ 
3130 
3140 
3150 
3160 
3170 
3180 
3190 
32060 
3210 
3220 
3230 
3240 
3250 
3260 
3270 
3286 
3290 
3360 
3310 
3320 
3330 
3340 
3350 
3360 
3370 
3380 
3390 
3400 
3416 
3420 
3430 
3440 
3450 
3460 
3470 
3480 
3490 
3500 
3510 
3520 
3530 
3540 
3550 
3560 
3570 
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836 


840 


850 


E2 = AMAX1(E2, SQRT(T/(S + T))) 
IF (K - L) 59@, 55@, 596 
TEST FOR ACCEPTANCE OF GROUP OF EIGENVECTORS 
IF (L .GE. EM .AND. D(EM)*WK(EM,2,2) .LT. EPS*(D(EM) - E)) 
G = EM 
IF (E2 - WK(L,2,2)) 560, 580, 58¢ 
DO 570 J = Ll, L 
WK(J,2,2) = E2 
CONTINUE 
IF (L .LE. EM .AND. D(L)*WK(L,2,2) .LT. EPS*(D(L) - E)) G=L 
CONTINUE 
ADJUST M. 
STATEMENT 600 IS EX6. 
G+l 
- .4E-¢1*D(1)) 616, 61@, 620 


630 

. 2E+01/E 

. SLE+OQ*E2 

= 2*INT(.4E+@1/AMINI(WK(1,1,2), .4E+#1)) 

= MIN@(M, K) 

REDUCE EM IF CONVERGENCE WOULD BE TOO SLOW. 

IF (WK(EM,2,2)) 640, 690, 64¢ 

LF (FLOAT(KS) - .9E+#@*FLOAT(KM)) 650, 696, 690 

S = FLOAT(K)*WK(EM, 1, 2) 

IF (S — .5E-@1) 666, 670, 67¢ 

T = .5E+¢O*S*WK(EM, 1, 2) 

GO TO 68¢ 

T = WK(EM,1,2) + ALOG(.5E+0@ + .5E+@@*EXP (-.2E+61*S) ) / FLOAT (K) 

S = ALOG(D(EM)*WK(EM, 2,2)/(EPS*(D(EM) - E))) 

IF (S*FLOAT(KS) .GT. T*FLOAT( (KM - KS)*KM)) EM = EM - 1 
STATEMENT 69@ IS EX2. 

DO 76¢ K = IG, JP 

WK(K,3,2) = D(RK) 

CONTINUE 

CALL INF(KS, G, H, WK(1,2,2)) 

IF (G .GE. EM .OR. KS .GE. KM) GO TO 113 
STATEMENT 71@ IS EX1. 

IF (KS + M - KM) 7306, 73¢, 720 


22 =-1 
IF (M .GT. 1) M = 2*((KM - KS + 1)/2) 
Ml =M 


SHORTCUT LAST INTERMEDIATE BLOCK IF ALL F(I) ARE SUFFICIENTLY 
SMALL. 
F (L — EM) 78@, 740, 74¢ 
= D(EM)*WK(EM, 2, 2)/(EPS*(D(EM) - E)) 
= S*S - .1E+#1 
F (T) 606, 60, 750 
= ALOG(S + SQRT(T))/(WK(EM,1,2) - WK(H+1,1,2)) 
M1 = 2*INT(.5E+0@*S + .101E+@1) 
IF (Ml - M) 776, 7706, 76¢ 
Ml = M 
GO TO 78¢ 
Z2 = -1 
CHEBYSHEV ITERATION 
IF (M - 1) 9606, 794, 8206 
DO 81@ K = IG, P 
CALL OP(N, X(1,K), WK(1,4,2)) 
DO 869 IT = 1, N 
X(1,K) = WK(I,4, 2) 
CONTINUE 
CONTINUE 
GO TO 96¢ 
Ll = Ml - 4 
DO 89¢ K = IG, P 
CALL OP(N, X(1,K), WK(1,4,2)) 
DO 836 T=1, N 
IK =I+N 
WK(IK,4,2) = E1*WK(I,4,2) 
CONTINUE 
CALL OP(N, WK(N+1,4,2), WK(1,4,2)) 
DO 840 I = 1, N 
X(I,K) = E2*WK(1,4,2) - X(1I,K) 
CONTINUE 
IF (L1) 89, 85¢, 850 
DO 886 J = 4, M1, 2 


I 
) 
T 
I 
S 


3580 
3590 
3600 
3610 
3620 
3630 
3640 
3650 
3660 
36706 
3680 
3690 
3700 
3710 
3720 
373¢ 
3740 
3756 
3760 
3770 
3780 
3790 
38060 
3810 
3820 
3830 
3840 
3850 
3860 
3870 
3880 
3890 
3900 
3910 
3920 
3930 
3946 
3950 


3960 
3970 
3980 
3990 
4000 
4610 
4020 
49630 
4040 
405¢ 
4060 
4070 
4980 
4090 
410606 
4110 
4120 
4130 
4146 
4150 
4160 
4176 
4180 
4190 
42060 
4210 
4220 
4230 
4240 
4250 
4260 
4270 
4280 
4290 
43060 
4310 
4320 
4330 
4346 
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860 


876 
880 
890 
906 


910 


aaa 


996 


1606 


1610 


1026 
1636 
1046 


1656 
1060 
1070 
1680 
1996 
1109 


111¢ 
112¢ 


C 


113¢ 
Cc 


1140 


CALL OP(N, X(1,K), WK(1,4,2)) 
DO 869 T= 1, N 


IK =L+N 
WK(IK,4,2) = E2*WK(1,4,2) - WK(IK,4,2) 
CONTINUE 
CALL OP(N, WK(N+1,4,2), WK(1,4,2)) 
DO 876 T= 1, N 
X(I,K) = E2*WK(1,4,2) - X(1,K) 
CONTINUE 
CONTINUE 
CONTINUE 
ASSIGN 9106 TO IK 
LF = IG 
Ll = P 
GO TO 99¢ 


DISCOUNTING THE ERROR QUANTITIES F 
IF (G - H) 926, 970, 976 
IF (M - 1) 954, 934, 950 
DO 94 K = IG, H 
WK(K,2,2) = WK(K, 2, 2)*(D(H+1) /D(K)) 
CONTINUE 
GO TO 976 
T = EXP(-FLOAT(M1) *WK(H+1, 1, 2)) 
DO 96¢ K = IG, H 
S = EXP(-FLOAT(M1)* (WK(K,1,2) - WK(H+1,1,2))) 
WK(K,2,2) = S*WK(K, 2,2)*(.1E+O1 + T*T)/(.1E+01 + (S*T)*(S*T)) 
CONTINUE 
KS = KS + M1 
Z2 = Z2 - Ml 
POSSIBLE REPETITION OF INTERMEDIATE STEPS 
IF (Z2) 986, 710, 716 
Zl1=Z1+1 
22 = QRZ1 
M=M+M 
GO TO 606 
PERFORMS ORTHONORMALIZATION OF COLUMNS 1 THROUGH L1 OF ARRAY 
X ASSUMING THAT COLUMNS 1 THROUGH LF - 1 ARE ALREADY ORTHO- 
NORMAL 
DO 112@ K = LF, Ll 
ORIG = .TRUE. 
T = .@E+tOO 
JIK=K- 1 
IF (JK) 1640, 16046, 1016 
DO 1636 I= 1, JK 
S$ = IP(N, X(1,1), X(1,K)) 
IF (ORIG) WK(K,I,1) =S 
T= T+ S*S 
DO 14626 J=1,N 
X(J,K) = X(J,K) - S*X(J,I) 
CONTINUE 
CONTINUE 
S = IP(N, X(1,K), X(1,K)) 
T=S+T 
IF (S - .1E-@1*T) 1660, 1064, 1065¢ 
IF (T -— MT) 1660, 1660, 10680 
ORIG = .FALSE. 
S = .GE+OO 
S = SQRT(S) 
WK(K,K,1) = S 
IF (S) 1696, 1146, 1690 
S = .1E+61/S 


DO 1116 J= 1, N 
X(J,K) = S*X(J,K) 
CONTINUE 
CONTINUE 


GO TO IK, (60, 96, 26@, 916, 114@) 
STATEMENT 113@ IS EX. 
EM = G 
SOLVE EIGENVALUE PROBLEM OF PROJECTION OF MATRIX C. 
ASSIGN 1146 TO IK 
LF = l 
Ll. = JP 
GO TO 99¢ 
DO 116¢ K = 1, JP 
CALL OP(N, X(1,K), X(1,P)) 


4359 
4360 
4370 
4380 
4396 
4400 
4410 
4426 
4436 
4440 
4450 
4460 
4470 
4480 
4496 
4500 
4510 
4520 
4530 
4540 
4556 
4560 
4570 
4580 
4590 
4600 
4610 
4626 
4630 
4646 
4650 
4660 
4676 
4686 
4690 
4706 
4710 
4720 
4730 
4740 
4750 
4760 
4770 
4780 
4796 
4800 
4810 
4820 
4830 
4840 
4859 
4860 
4870 
4880 
4899 
4900 
4919 
4920 
4930 
4946 
4950 
4960 
4976 
4980 
4990 
5000 
5016 
5020 
5030 
504¢ 
5050 
5060 
5070 
5080 
5090 
5160 
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po 115@ T= 1, K 
WK(K,I,1) = -IP(N, X(1,1), X(1,P)) 
115@ CONTINUE 
116@ CONTINUE 
CALL TRED2(P, JP, WK, D, WK(1,4,2), WK) 
CALL IMTQL2(P, JP, D, WK(1,4,2), WK, L) 
WK(IG,2,2) = AMAX1(WK(IG,2,2), .1E+@4*FLOAT(L)) 


DO 


ARRANGE EIGENVALUES IN ORDER OF DECREASING ABSOLUTE VALUE. 
1216 J = 1, JP 


K=J 


DO 1176 I = 


1176 =6C 
I 
1189 T 
D 
D 
D 


1196) «6 C 
12400 OD 
121@ CON 
DO 

D 


1220 


1230 C 


DO 1246 I = 


1246 ¢ 
125@ CON 


J, JP 

IF (ABS(D(I)) .GT. ABS(D(K))) K = I 
ONTINUE 

F (K Oty J) 1260, 1200, 1186 
= D(K) 

(K) = DW) 

Pau 
0 1199 I= 1, JP 

T = WK(I,K,1) 

WK(I,K,1) = WK(I,J,1) 
WK(I,J,1) =T 
ONTINUE 

(J) = -D(@J) 
TINUE 

1256 J= 1, N 
0 1239 I = 1, JP 

S = .GE+b¢ 

DO 1226 K = 1, JP 

S = S + X(J,K)*WK(K,I,1) 

CONTINUE 

WK(1,4,2) = S$ 

ONTINUE 
1, JP 

X(J,1I) = WK(I, 4,2) 
ONTINUE 
TINUE 


KM = KS 


D(P 
RET 
END 
PRO 


iE 
URN 


GRAM TESTB(INPUT, OUTPUT, TAPE5 = INPUT, TAPE6 = OUTPUT) 


DIMENSION A(5@,6), T(50,6), Y(5@) 
COMMON NT, T, NA, A, ND, Y 

INTEGER Y 

DIMENSION X(50,10), D(16), WK(115,2) 
EXTERNAL INTROS, ABAND, BAND 


C 

C THE VARIABLE ND MUST IDENTIFY A VALUE AT LEAST EQUAL TO N. 

C THE VALUE ASSIGNED TO THE VARIABLE ND MUST AGREE WITH THE LEADING 

C DIMENSION OF THE VARIABLES A, T, X, AND Y. THE LEADING DIMENSION OF 
C THE VARIABLE WK MUST EQUAL OR EXCEED ND + 65. THE SECOND DIMENSION 
C OF A AND T MUST EXCEED NA AND NT, RESPECTIVELY. OTHERWISE RECOMPILE. 
C NOTE THAT DIMENSIONS OF THE VARIABLES A, T, AND Y MUST AGREE WITH 

C THEIR COUNTERPARTS IN FUNCTION BAND AND SUBROUTINE ABAND. 

C 

Cc ON IS AN INTEGER INPUT VARIABLE, THE ORDER OF THE MATRICES A AND 
C B. IF N .LE. @, PROCESSING CEASES. 

C NA IS AN INTEGER INPUT VARIABLE, THE NUMBER OF ADJACENT NON-ZERO 
C DIAGONALS STRICTLY BELOW THE MAIN DIAGONAL OF THE MATRIX A. 

C NT IS AN INTEGER INPUT VARIABLE, THE NUMBER OF ADJACENT NON-ZERO 
C DIAGONALS STRICTLY BELOW THE MAIN DIAGONAL OF THE MATRIX T. 

C KM IS AN INTEGER INPUT VARIABLE, THE MAXIMUM NUMBER OF ITERATION 
C STEPS TO BE EXECUTED BY SIMITZ ON EACH CALL. IF KM IDENTIFIES 
C A NEGATIVE VALUE, SIMITZ WILL USE PREVIOUSLY COMPUTED EIGENVEC 
C TORS AS INITIAL APPROXIMATIONS FOR A GIVEN VALUE OF P WHILE EM 
C IS INCREASED. 

C EPS IS A REAL INPUT VARIABLE, THE TOLERANCE FOR ACCEPTING EIGEN-— 

C VECTORS. 

-C SEED IS A REAL INPUT VARIABLE TO INITIALIZE THE RANDOM NUMBER GEN- 
C ERATOR RANF USING THE INITIALIZING SUBROUTINE RANSET. IF SEED 
C IDENTIFIES A NEGATIVE VALUE, NO PRINTING OF THE NON-ZERO 

C DIAGONALS WILL BE DONE. 

C TRANSA IS A REAL INPUT VARIABLE, THE LEFT ENDPOINT OF THE INTERVAL 

C FROM WHICH THE NON-ZERO ENTRIES OF A AND T ARE SELECTED. 

C DIALA IS A REAL INPUT VARIABLE, A POSITIVE NUMBER SELECTED SO THAT 
C TRANSA + DIALA IS THE RIGHT ENDPOINT OF THE INTERVAL OVER 
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30 


46 


5 


60 
70 


80 


90 
106 
110 


120 
130 


146 
156 


160 


17¢ 
18¢ 
19¢ 


192 


194 
196 
198 


210 


WHICH THE NON-ZERO ENTRIES OF A AND T ARE SELECTED. 


ND = 5@ 
READ (5, 20) N, NA, NT, KM, EPS, SEED, TRANSA, DIALA 
FORMAT (415, 1P4E1@. 2) 
IF (N .LE. 6) STOP 
CALL RANSET(ABS (SEED) ) 
MPL = NT +1 
DO 4@¢ I = 1, N 

MAX = MAX@(1, -I + (MP1 + 1)) 

DO 3¢@ J = MAX, MPL 

T(1,J) = AINT(TRANSA + DIALA*RANF(1)) 


CONTINUE 
T(I,MP1) = AMAX1(ABS(T(I,MP1)), ABS(AINT(TRANSA + DIALA)) - 

* ABS (T(1,MP1))) 

CONTINUE 


WRITE (6, 5@) N, NA, NT, KM, EPS, SEED, TRANSA, DIALA 

FORMAT (1H1, 6X, 1HN,11X, 2HNA,11X, 2HNB, 11X, 2HKM, 18X, 3HEPS,17X,4HSEED, 
* 10X, LIHTRANSLATION, 13X, 8HDILATION/1H /18,3113,1P4E21.2/1H@) 
IF (SEED) 110, 60, 6¢ 

WRITE (6, 7) 

FORMAT (1H@, 36X,59HADJACENT NON-ZERO LOWER DIAGONALS OF T, T(T-TRAN 
*SPOSED) = B) 


MAX = MP1 
DO 99 J = 1, MP1 
DO 86 I= J, N 
Y(I) = TFIX(T(1,MAX)) 
CONTINUE 


WRITE (6, 100) (Y(I), I = J, N) 
MAX = MAX - 1 
CONTINUE 
FORMAT (1H /(16X,1517)) 
MP1 = NA+ 1 
pO 136 T= 1, N 
MAX = MAX@(1, -I + (MP1 + 1)) 
DO 126 J = MAX, MP1 
A(I,J) = AINT(TRANSA + DIALA*RANF(1)) 
CONTINUE 
CONTINUE 
IF (SEED) 18@, 14¢, 14¢ 
WRITE (6, 15) 
FORMAT (1H@/39X, 53HADJACENT NON-ZERO LOWER DIAGONALS OF A = A-TRANS 
*POSED) 
MAX = MP1 
DO 17@¢ J = 1, MPL 
DO 169 I = J, N 
Y(I) = LFIX(A(1,MAX)) 
CONTINUE 
WRITE (6, 160) (Y(I), I = J, N) 
MAX = MAX - 1 
CONTINUE 
WRITE (6, 190) 
FORMAT (1H@/1H@, 21X,1HP,5X,6HEM(IN) ,4X, 7HEM(OUT) ,9X, 2HKS, 10X,1HK, 
*6X, 12HMAX RESIDUAL, 5X, 13HMEAN RESIDUAL, 8X, 1@HTIME(SECS)/1H ) 
MP = MIN@(N/5, 10) 
IF (KM) 192, 198, 198 
DO 196 J = 1, MP 
po 194 l=1, N 
X(I,J) = 2.Q@*RANF(2.06) - 1.@ 
CONTINUE 
CONTINUE 
DO 28¢ IP = 2, MP 
MAXM = IP - 1 
DO 27@ M = 1, MAXM 
MM = M 
KS = KM 
Tl = SECOND(S) 
CALL SIMITZ(N, IP, KS, EPS, BAND, ABAND, INTRCS, MM, X, ND, D, 
* WK) 
Tl = SECOND(S) - Tl 
IF (MM) 206, 2646, 2106 
L= 6 
ANMAX = 1.9 
ANMEAN = 1.0 
GO TO 25¢ 
PROD = 1.0 


5870 
5886 
5890 
590¢ 
591¢ 
5920 
5930 
5940 
5950 
5960 
5970 
59860 
5990 
6000 
6010 
6020 
6030 
6040 
6050 
6060 
6070 
6080 
6090 
6100 
6110 
6120 
6130 
6140 
6156 
6160 
6170 
6186 
£338 
6210 
6220 
6230 
6246 
6250 
6260 
6270 
6280 
6290 
6300 
6310 
6320 
6330 
6340 
635¢ 
6360 
6370 
6380 
6390 
6400 
6410 
6420 
6430 
6440 
645 
6460 
6470 
6480 
6490 
6500 
6510 
6520 
6530 
6540 
6550 
6560 
6570 
6586 
6590 
6600 
6610 
6620 
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226 


230 


240 


25@ 
260 
270 
280 


296 


ANMAX = ¢.¢@ 
i= 1 
DO 246 J = 1, MM 
CALL BANDOP(N, NA, A, ND, X(1,J), WK(1,1)) 
CALL TANDOP(N, NT, T, ND, X(1,J), WK(1,2)) 
5 = 0.6 
DO 236 I= 1, N 
S = S + (WK(I,1) - D(J)*WK(I,2))*(WK(I,1) - D(J)*WK(T,2)) 
CONTINUE 
PROD = PROD*S 
ANMAX = AMAX1(ANMAX, S) 
L = MAX1(FLOAT(L), SIGN(FLOAT(J), S - ANMAX)) 
CONTINUE 
S = ABS(D(1)) - D(IP) 
ANMAX = SQRT(ANMAX)/S 
ANMEAN = SQRT(PROD** (1.@/FLOAT (MM) ))/S 
WRITE (6,260) IP, M, MM, KS, L, ANMAX, ANMEAN, T1 
FORMAT (123, 4111, 1P2E18.2,@PF18. 2) 
CONTINUE 
CONTINUE 
WRITE (6,296) (D(J), J = 1, MAXM) 
FORMAT (1H@/1H@,57X,17HFINAL EIGENVALUES/1H /(1PE37.12,4E21.12)) 
GO TO 1¢ 
END 


SUBROUTINE INTROS(KS, G, H, F) 


C INTROS IS A DUMMY SUBROUTINE INF. 


INTEGER G, H 
REAL F(1) 


RETURN 
END 


SUBROUTINE BANDOP(N, NA, A, ND, V, W) 


C CALCULATE THE IMAGE W OF THE N-VECTOR V UNDER 
C THE MATRIX A WHERE A IS SYMMETRIC AND BANDED OF BAND WIDTH 24*NA + 1. 


1¢ 


DIMENSION A(ND,1), V(1), W(1) 
INTEGER P, Q, R 

MP1 = NA +1 

pO 7I=1, N 


= MAX@(1, I + (MP1 - N)) 
= A(I,MP1)*V(I) 

1 - P) 

P, NA 
A(I,K)*V(R) 

1 


[o) 

ho 
ore 
++ ‘2 


T 
R = 
IN 
Ps Q) 60, 4, 46 
(MP1 - Q) 
= Q, NA 
+ A(R,K)*V(R) 
R- 1 

CONTINUE 

WI) = T 
CONTINUE 
RETURN 
END 


Do 5 


Zz 
nat” Gran 


wm 
I 
t | OH ae Ih 


SUBROUTINE TANDOP(N, NA, A, ND, V, W) 


C COMPUTE THE IMAGE W OF THE N-VECTOR V UNDER THE N-SQUARE MATRIX 


C 


1¢ 


A(A-TRANSPOSED) , A LOWER TRIANGULAR OF BANDWIDTH NA + 1. 
DIMENSION A(ND,1), V(1), W(1) 
INTEGER P, Q, R 
MP1 = NA +1 
pO 46 I= 1, N 
P = MAXO(1, I + (MP1 - N)) 
T = A(I,MP1)*V(T) 
IF (NA - P) 30, 16, 10 


R= 1+ (MP1 - P) 

DO 20 K = P, NA 
T = T + A(R,K)*V(R) 
R=R-1 


6630 
6646 
6650 
6660 
6670 
66890 
6690 
6700 
6710 
6720 
6730 
6746 
6750 
6760 
6776 
6780 
6790 
6866 
6816 
6820 
6830 
6840 
6850 
6860 


6870 
688¢ 
6890 


6900 


691 
692 


6930 
6940 
6950 
6960 
6970 
6980 
6990 
7600 
7610 
7620 
7930 
7040 
7056 
7060 
7070 
7080 
7090 
7160 
7110 
7120 
7130 
7140 
7150 
716@ 
7170 
7180 


7190 
7200 
721¢ 
7220 
7230 
7240 
7250 
7260 
7270 
7280 
7290 
73060 
731¢ 
7320 
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2¢ CONTINUE 

3¢ W(I) = T 

46 CONTINUE 
I=N 


DO 86 Q= 1, N 
P = MAX@(1, -I + (MP1 + 1)) 
T = A(I,MP1)*W(Z) 
IF (NA - P) 76, 5@, 5@ 


50 R= 1- (MP1 - P) 
DO 6¢ K = P, NA 
T = T + A(I,K)*W(R) 
R=R+1 
60 CONTINUE 
70 W(I) =T 
IT=I-1 
86 CONTINUE 
RETURN 
END 


FUNCTION BAND(N, Z, W) 
C CALCULATE THE INNER PRODUCT (W-TRANSPOSED)BZ WHERE B = 
C T(T-TRANSPOSED) . 
DIMENSION A(5@,6), T(5@,6), Y(5@) 
COMMON NT, T, NA, A, ND, Y 
DIMENSION W(1), Z(1) 
1@ CALL TANDOP(N, NT, T, ND, Z, Y) 
S = 0.0 
pO 1i5I=1, N 
S = S + W(I)*Y(1) 
15 CONTINUE 
BAND = S 
RETURN 
END 


SUBROUTINE ABAND(N, Z, W) 
CALCULATE THE SOLUTION W OF THE LINEAR SYSTEM BW = AZ GIVEN THE 
N-VECTOR Z, THE BANDED SYMMETRIC N-SQUARE MATRIX A OF BAND WIDTH 
2*NA + 1, AND THE BANDED TRIANGULAR FACTOR T OF BAND WIDTH NT + 1 
OF THE POSITIVE DEFINITE MATRIX B, T(T-TRANSPOSED) = B. 

DIMENSION W(1), Z(1) 

DIMENSION A(5@,6), T(50,6), Y¥(5@) 

COMMON NT, T, NA, A, ND, Y 

CALL BANDOP(N, NA, A, ND, Z, W) 

CALL SOLVE(N, NT, T, ND, W) 

RETURN 

END 


aaa A 


SUBROUTINE SOLVE(N, M, A, Nl, B) 
C SOLVE A LINEAR SYSTEM GIVEN A TRIANGULAR FACTORIZATION OF A BANDED 
Cc POSITIVE DEFINITE COEFFICIENT MATRIX OF BAND WIDTH 2*M + 1. 
DIMENSION A(N1,1), B(N) 
INTEGER P, Q, R 
MP1=M+1 
COMMENT SOLUTION OF LY = B 
DO 136 T= 1, N 


P = MAXO(1, MP1 - I + 1) 

T = B(1) 

IF (M - P) 126, 160, 160 
160 Q=I1I-MP1+P 

DO 116 K = P, M 


T = T - AC(I,K)*B(Q) 
Oe Bei 
11¢ CONTINUE 
129 B(I) = T/A(I,MP1) 
13@ CONTINUE 
COMMENT SOLUTION OF UX = Y 
I=N 
DO 17@¢ R=1,N 
P = MAX@(1, MP1 - N + I) 
T = B(L) 
IF (M - P) 16@, 140, 14¢ 
146 Q=I1I+MPl - P 
DO 15@ K = P, M 


7330 
7340 
7350 
7360 
7370 
7380 
7390 
7400 
7410 
7420 
7430 
7440 
7450 
7460 
7470 
7480 
7490 
7500 


751@ 
7520 
753¢ 
7546 
7550 
7566 
7570 
7580 
7590 
7600 
7616 


7626 


7630 
7640 


7650 
7660 
767@ 
7680 
769¢ 
7700 
7710 
7720 
7730 
774 
775@ 
776@ 


7770 
7780 
779@ 
7800 
7810 
782¢ 
783@ 
7840 
7850 
7860 
7870 
7880 
7890 
7900 
791@ 
7920 
7930 
7940 
7950 
7960 
7976 
7980 
7990 
8600 
8010 
8020 
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ALGORITHMS (cont.) 
- A(Q,K)*B(Q) 
=! 


150 E 
160 T/A(1,MP1) 
T=I-1 
176 CONTINUE 
RETURN 


END 


FUNCTION RANF(X) 
RETURNS A RANDOM NUMBER ON THE OPEN UNIT INTERVAL GIVEN ANY ARGUMENT. 
COMMON /TSEED/ K 
K = MOD(3125*K, 65536) 
RANF = ABS(FLOAT(K - 32768) /32768.@) 
RETURN 
END 


SUBROUTINE RANSET (SEED) 


C INITIALIZES THE RANDOM NUMBER SEED K USING THE REAL INPUT 


C 


OO OO cS oS 


aa 


AOA OAM AGA Aone aon ane a aas 


VARIABLE SEED. 
COMMON /TSEED/ K 
T = SEED 
IF (ABS(SEED) .GT. 1.6) T = 1.6/T 
K = 2*IF1IX(16384.@4T) - IFIX(SIGN(1.@, T)) 
RETURN 
END 


FUNCTION SECOND(T) 
DUMMY FUNCTION SECOND RETURNS THE VALUES SECOND = T = 0.0. 


SECOND MAY BE MODIFIED TO CALL AN OPERATING SYSTEM DEPENDENT PROGRAM 
WHICH RETURNS CENTRAL PROCESSOR TIME IN SECONDS RELATIVE TO 
AN ARBITRARY STARTING POINT AS A REAL VALUE T. 


T = 6.4 
SECOND = 6.0 
RETURN 

END 


SUBROUTINE IMTQL2(NM,N,D,E,Z, LERR) 


INTEGER 1,J,K,L,M,N,II,NM,MML,IERR 
REAL D(N),E(N),Z(NM,N) 

REAL B,C,F,G,P,R,S,MACHEP 

REAL SQRT,ABS,SIGN 


THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PRCICEDURE IMTQL2, 
NUM. MATH. 12, 377-383(1968) BY MARTIN AND WILKINSON, 
AS MODIFIED IN NUM. MATH. 15, 4506(1976) BY DUBRULLE. 
HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 241-248(1971). 


THIS SUBROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS 

OF A SYMMETRIC TRIDIAGONAL MATRIX BY THE IMPLICIT QL METHOD. 
THE EIGENVECTORS OF A FULL SYMMETRIC MATRIX CAN ALSO 

BE FOUND IF TRED2 HAS BEEN USED TO REDUCE THIS 

FULL MATRIX TO TRIDIAGONAL FORM. 

ON INPUT- 

NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL 
ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT, 

N IS THE ORDER OF THE MATRIX, 

D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, 


E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX 
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a 


10 


165 


IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, 

Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE 
REDUCTION BY TRED2, IF PERFORMED. IF THE EIGENVECTORS 
OF THE TRIDIAGONAL MATRIX ARE DESIRED, Z MUST CONTAIN 
THE IDENTITY MATRIX. 


ON OUTPUT- 


D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN 
ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT BUT 
UNORDERED FOR INDICES 1,2,...,IERR-1, 


E HAS BEEN DESTROYED, 


Z CONTAINS ORTHONORMAL EIGENVECTORS OF THE SYMMETRIC 
TRIDIAGONAL (OR FULL) MATRIX. IF AN ERROR EXIT IS MADE, 
Z CONTAINS THE EIGENVECTORS ASSOCIATED WITH THE STORED 
EIGENVALUES, 


IERR IS SET TO 
ZERO FOR NORMAL RETURN, 
J IF THE J-TH EIGENVALUE HAS NOT BEEN 
DETERMINED AFTER 30 ITERATIONS. 


QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, 
APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY 


RKKKKRAKKK MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING 


THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. 


REKKKEKKKER 
MACHEP = 2.%**(-47) 
IERR = @ 
IF (N .EQ. 1) GO TO 1661 
DO 199 I = 2, N 
E(I-1) = E(L) 
E(N) = @.¢@ 
DO 246 L= 1, N 
J=@6 
KAKKKAKEKE TOOK FOR SMALL SUB-DIAGONAL ELEMENT **4%xxkx4% 
pO 116 M=L, N 
IF (M .EQ. N) GO TO 126 
IF (ABS(E(M)) .LE. MACHEP * (ABS(D(M)) + ABS(D(M+1)))) 


x GO TO 12¢ 
CONTINUE 
P = D(L) 


IF (M .EQ. L) GO TO 24¢ 
IF (J .EQ. 36) GO TO 10600 
J=I+1 
KKKEKKKKKKE FORM SHIFT KREREKKEKKK 
(D(L+1) - P) / (2.0 * E(L)) 
SQRT (G*G+1.0) 
D(M) - P + E(L) / (G + SIGN(R,G)) 
ae < 


Hud uw hb ow 


ANnNARAA 


‘enaaeess FOR I=M-1 STEP -1 UNTIL L DO —— #x*xkkKeKK 
DO 20@ IIT = 1, MML 


I=M- II 

F=S * E(I) 

B= C * E(I) 

IF (ABS(F) .LT. ABS(G)) GO TO 15¢ 
c=G/F 

R= oa 0) 


8700 
8710 
8726 
8730 
8740 
875 
8760 
8770 
8780 
8790 
8800 
8810 
8820 
8830 
8840 
8850 
8866 
8870 
8880 
8890 
8900 
8916 
8920 
8930 
8940 
8950 
8960 
8970 
8980 
899¢ 
9060 
90106 
9020 
9930 
9640 
9050 
9060 
9070 
9980 
9090 
9160 
911¢ 
912¢ 
9130 
9140 
915¢ 
91606 
917¢ 
9180 
9190 
9206 
9210 
9226 
9230 
9246 
925¢ 
9260 
9270 
9280 
9290 
9300 
9310 
9320 
9336 
9340 
9350 
9360 
937@ 
9380 
9399 
9400 
9410 
9420 
9430 
9440 
9450 
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150 


16¢ 


186 


200 


240 


260 


280 


3060 


AAAANRARAANRAAAN 


GO TO 16¢ 
S=F/G 

R = SQRT(S*S+1.@) 
E(I+1) =G*R 


C=1.0/R 

S=S*C 

G = D(I+1) - P 

R= (D(I) -G) *S+2.060* C*B 
P=S*R 


D(I+1) = G+P 
G=C*R-B 
REKKKKKKKKE FORM VECTOR #X#RKRKKKE 

pO 186 K = 1, N 
F = Z(K,I4+1) 
Z(K,I+1) = S * Z(K,I) + Cc * 
Z(K,I) = C * Z(K,I) -S * F 

CONTINUE 


F 


CONTINUE 


D(L) 
E(L) = G 
E(M) = @.@ 
GO TO 105 
CONTINUE 
RRKKKKKKKK ORDER EIGENVALUES AND EIGENVECTORS ***xkkxkKX 
DO 36@ IL = 2, N 


D(L) - P 


T=I1IT-1 
KeTf 
P = D(I) 


DO 26¢ J = II, N 
IF (D(J) .GE. P) GO TO 266 
K= J 

P = D(J) 

CONTINUE 


IF (K .EQ. I) GO TO 3¢¢ 
D(K) = D(I) 
D(I) = P 


DO 286 J = 1, N 
P = Z(J,1) 
Z(J,I) = Z(J,K) 
Z(J,K) = P 

CONTINUE 


CONTINUE 


GO TO 10¢1 

RKKKKKKKKK SET ERROR ~- NO CONVERGENCE TO AN 
EIGENVALUE AFTER 30 ITERATIONS #***kkkkex 

IERR = L 

RETURN 

EKEKKKKEKKK LAST CARD OF IMTQL2 RRRRERKEKKK 

END 


SUBROUTINE TRED2(NM,N,A,D,E,Z) 


INTEGER I,J,K,L,N,II,NM,JP1 
REAL A(NM,N),D(N),E(N) ,Z(NM,N) 
REAL F,G,H,HH,SCALE 

REAL SQRT,ABS,SIGN 


THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED2, 
NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. 
HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). 


THIS SUBROUTINE REDUCES A REAL SYMMETRIC MATRIX TO A 
SYMMETRIC TRIDIAGONAL MATRIX USING AND ACCUMULATING 
ORTHOGONAL SIMILARITY TRANSFORMATIONS. 


ON INPUT- 
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Q 


100 


12¢ 


139 


149 


15¢ 


180 


200 


220 


NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL 
ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT, 


N IS THE ORDER OF THE MATRIX, 


A CONTAINS THE REAL SYMMETRIC INPUT MATRIX. ONLY THE 
LOWER TRIANGLE OF THE MATRIX NEED BE SUPPLIED. 


ON OUTPUT- 
D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX, 


E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL 
MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO, 


Z CONTAINS THE ORTHOGONAL TRANSFORMATION MATRIX 
PRODUCED IN THE REDUCTION, 


A AND Z MAY COINCIDE. IF DISTINCT, A IS UNALTERED. 


QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, 
APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY 


DO 199 J = 1, I 
Z(I,J) = A(I,J) 
CONTINUE 


IF (N .EQ. 1) GO TO 326 
AAKKKKAKEK FOR I=N STEP -1 UNTIL 2 DO -— *kkeRRARAK 


DO 36¢@ II = 2, N 


I=N+2-TI1 
L=I-1 

H = 6.6 

SCALE = $.@ 


IF (L .LT. 2) GO TO 130 

HHKKKKKKKK SCALE ROW (ALGOL TOL THEN NOT NEEDED) ****e4444% 
pO 1296 K = 1, L 
SCALE = SCALE + ABS(Z(I,K)) 


IF (SCALE .NE. @.6) GO TO 14¢ 
E(I) = Z(I,L) 
GO TO 29¢ 


po 15@ K = 1, L 
Z(1,K) = Z(1,K) / SCALE 
H = H + Z(1,K) * Z(I,K) 


CONTINUE 
F = Z(I,L) 
G = -SIGN(SQRT(H) , F) 


E(I) = SCALE * G 
H=H-F*G 
Z(I,L) = F-G 

F = 6.6 


DO 2496 J = 1, L 
Z(J,1) a Z(1,J) / 4 
G = 0.0 
KKKKKAAKEK FORM ELEMENT OF A®U *4& eR 
pO 186 K= 1, J 
G = G+ Z(J,K) * Z(1,K) 


JPl=J+1 
IF (L .LT. JP1) GO TO 220 


DO 2¢@ K = JP1, L 

G =G + Z(K,J) * Z(1,K) 
REKKKKEEKK FORM ELEMENT OF P &&&&kRAKKK 

E(J) =G/H 

F=F+ E(J) * Z(1I,J) 


16210 
1022¢ 
10230 
10240 
10250 
16260 
16270 
1628 
16296 
103060 
1031 
10320 
1933¢ 
1034¢ 
10350 
19360 
16370 
19380 
16390 
194060 
10410 
10426 
10430 
10440 
10450 
10460 
16470 
10480 
19490 
195060 
1051¢ 
16520 
10530 
19546 
19550 


19566 
10570 
19580 
16590 
19600 
19610 
19620 
19630 
10640 
19650 
19660 
1¢67¢ 
10680 
19690 
10700 
19710 
10720 
10730 
1074@ 
10750 
10760 
10776 
1¢780 
190790 
108060 
19810 
19820 
10830 
10846 
10850 
19860 
10870 
19880 
19899 
199060 
16916 
16926 
10930 
16940 
10950 
19960 
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246 CONTINUE 10970 
Cc 10980 
HH = F / (H + H) 19990 
Cc RKKKKKKKKK FORM REDUCED A KEKEKKKKEE 110600 
DO 266 J= 1, L 11610 
F = Z(1,J) 11420 
G=E(J) - HH * F 114630 
E(TY =:G 110646 
Cc 11650 
DO 260 K=1, J 11060 
Z(J,K) = Z(J,K) - F * E(K) - G * Z(1,K) 1107¢ 
260 CONTINUE 11980 
Cc 1109¢ 
290 D(I) =H 11100 
30@ CONTINUE 11110 
Cc 11120 
326 D(1) = 6.0 1113¢ 
E(1) = ¢.¢ 11146 
Cc AEKKKKKKKK ACCUMULATION OF TRANSFORMATION MATRICES *****kkkKK 1115¢ 
DO 5@@ IT=1, N 11166 
L=tTI-l 11176 
IF (D(I) .EQ. ¢.6) GO TO 38@ 1118¢ 
Cc 11190 
DO 3606 J = 1, L 11200 
G = ¢.0 11210 
Cc 1122 © 
DO 349 K= 1, L 11236 
340 G = G+ Z(1I,K) * Z(K,J) 112406 
Cc 11250 
no 360 K = 1, L 11260 
Z(K,J) = 2(K,J) - G * Z(K,1) 11276 
360 CONTINUE 1128¢ 
Cc 
386 D(I) = Z(1,1) 11338 
Z(I,I) = 1. 11310 
IF (L .LT. 1) GO TO 500 11320 
Cc 11330 
DO 466 J= 1, L 1134¢ 
Z(1,J) = 0. 11350 
Z(J,1) = 0.0 11360 
400 CONTINUE 11370 
Cc 1138 
50@ CONTINUE 11390 
Cc 11406 
RETURN 11416 
C KEKRERKKKE LAST CARD OF TRED2 KRERKRKREEE 1142 
END 11434 
30 5 4 206 1.Q0@E-10 1.00E-@1 -1.0@E+01 2.0GE+01 DATA 
3¢ 5 4 -200 1.Q@@E-10 -1.0@E-@1 -1.G@E+01 2.Q0E+61 DATA 
40 4 3 206 1.0@E-16 2.0Q@E-G1 -1.QGE4+02 2.06E+)2 DATA 
4o 4 2-206 1.Q0@E-10 -2.GGE-@1 -1.G@E+02 2.0GE+G2 DATA 
50 2 1 200 1.@0@E-10 3.0@E-@1 -1.0Q@E+02 2. QGE+02 DATA 
5¢ 2 1 -260 1.@@E-16 -3.0GE-@1 -1.Q@QEt®G2 2.0@0E+02 DATA 
rn) DATA 
1 N NA NB KM EPS 
30 5 4 200 1.00E-10 
) 
") ADJACENT NON-ZERO LOWER DIAGONALS 
7 7 7 10 9 1¢ 6 9 
5 9 7 5 8 7 6 8 
8 5 -5 -5 3 -4 8 -9 
5 6 -4 -9 -7 2 5 -3 
4 5 3 -6 9 -6 -6 2 
) -2 2 6 -1 4 6 -1 
d ST m2 i) -9 4 4 -9 8 
-8 -7 i) 4 6 -8 -5 -3 <5 
-6 9 6 -4 3 7 2 1 =1 
1 -7 ~8 8 9 -5 3 3 5 
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ADJACENT NON-ZERO LOWER DIAGONALS 


(1) 7 6 -4 -6 5 8 3 -7 
-8 i -4 6 -9 8 5 3 -4 
-7 -1 ) 4 8 1 -5 0 5 
-4 i) 4 4 5 -2 2 -7 -3 
-2 -1 -8 7 a i) -6 6 9 
2 1 9 5 -6 -6 -6 1) -~9 
i) 1) -8 4) -9 “) @ 7 6 
6 5 -6 9 -8 5 -4 -9 6 
= y) -5 8 @ -6 -9 5 -7 
6 =5 2 1) 6 -4 -5 -2 ~-4 
-8 i) 8 3 9 4 {. 9 -8 
3 3 -8 1) Z -6 -4 ) 4 
i) 
¢ P EM(IN) EM (OUT) KS K MAX RES 
2 1 1 29 1 8.6 
3 L 1 15 1 6.4 
3 2 2 24 1 4.9 
4 1 1 15 1 Tek 
4 2 2 15 1 1.3 
4 3 3 51 1 Led 
5 af 1 13 1 9.9 
5 2 2 13 1 5 ek 
5 3 3 21 1 6.2 
5 4 4 21 1 1.3 
6 1 1 13 1 1.7 
6 2 2 13 1 5.4 
6 3 3 21 1 7.2 
6 4 4 13 1 9.6 
; 6 5 5 46 1 1.2 
i) FINAL EIGENVALUES 
4.550169524972E+$1 2.42710357641GE+O1 —-7.628352951042E+00 
1 N NA NB KM EPS 
30 5 4 -26¢ 1.Q0@E-10 
i) 
Q 
¢ P EM(IN) EM (OUT) KS K MAX RES 
2 1 1 30 1 8.4 
3 1 1 3 1 5.7 
3 2 2 15 1 1.1 
4 1 1 3 1 ie) 
4 2 2 3 1 9.3 
4 3 3 31 1 S2 
5 1 1 3 1 7.3 
5 2 2 3 1 5.0 
5 3 3 3 1 9.1 
5 4 4 3 1 6.3 
6 1 1 3 1 6.2 
6 2 2 3 1 1.3 
6 3 3 3 1 8.5 
6 4 4 3 1 Tat 
6 5 5 18 1 1.3 
@ 
@ FINAL EIGENVALUES 
4.550109524972E+01 2.42716357641Q@E+$1 —-7.628352951042E+00 
aa N NA NB KM EPS 
4Q 4 3 266 1.QGE-10 
i) 
) ADJACENT NON-ZERO LOWER DIAGONALS 
50 62 67 76 78 67 67 98 160 
82 66 64 84 66 89 76 50 60 


58 61 99 56 160 91 55 83 68 
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4g 


72 
-3 
-15 


a) 


OW WOM DWONNN NNN DNHDNAHANKADMNMNMNN EE PwWw Dd 


-21 


EM(IN) 


NDUOEPWNE DOP WHE UBWNHOERPWNHWNENF BR 


-61 79 
25° -85 
~96 76 
35 26 
-96 60 
4g 23 
-47 47 
-61 -86 
55 25 


-1.959611168616E+63 
-6. 8693942169 3GE-62 


NA 


4 


P 


NB 


3 


EM(IN) 


1 


-36 -86 29 -13 
21 37 3 77 
26 52 -39 72 

-5@ 76 -75 -27 

-81 -71 -71 -45 
39 35 -91 
74 -44 -18 -71 

-25 1¢ 16 32 

-19 14 


ADJACENT NON-ZERO LOWER DIAGONALS 


DANO PWNHE UU WNHPURWNHEP PWN W NED Ee 


39 12 -48 -99 
62 64 -17 -64 
-76 -20 -57 77 
-86 40 -14 69 
51 46 -33 53 
-15 -71 6 17 
24 63 -50@ -22 
-43 -34 -46 -~98 
41 72 -81 
~97 -57 -14 -67 
-79 7 3 -54 
-28 43 
-3 55 -24 
-44 9 -8 ~68 
KS K MAX RES 
13 1 2.8 
13 1 4.2 
13 1 4.3 
7 1 5.0 
13 1 4.1 
54 1 3.8 
7 1 4.9 
13 1 5.2 
3 1 4.@ 
17¢ 1 5.2 
7 1 4.8 
13 1 4.4 
3 1 4.6 
3 1 5.0 
26 1 6.7 
7 1 5.6 
13 1 5.6 
25 1 5.9 
27 1 5. 
27 1 5.0 
91 1 6.6 
7 1 5.7 
13 1 5.5 
39 1 6.9 
37 1 6.1 
28 1 7.8 
18¢ 1 6.6 
177 1 7.8 


FINAL EIGENVALUES 


-2.114191261132E+@1 2.8256062639426E-@1 
-6.243596342913E-G2 


KM 
-200 
EM(OUT) 


1 


EPS 
1.Q0E-16 

KS K MAX RES 

13 1 3.1 
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SDU PWN HAUS WHE UP WHE PWN WHE DE 


i) 
") 
-1.659611168016E+063 
—6. 809394215568E-G2 
1 N NA NB 
50 2 1 
@ 
) 
74 79 1606 
71 61 74 
51 96 98 
72 95 62 
46 11 -81 
59 96 -54 
-26 -26 73 
92 -5 1 
) 
-46 84 -74 
9¢ 74 -97 
61 -57 -55 
-27 77 -98 
-67 i) -19 
-6 -63 -4 
-38 73 35 
73 26 -66 
13 -74 -67 
57 61 56 
62 30 -37 
-34 -47 -78 
¢ 
7) P EM(IN) 
2 1 
3 1 
3 2 
4 1 
4 2 
4 3 
5 1 
5 2 
5 3 
5 4 


BDO SWNE AUP WHE UR WON RF RWN EW NED eH 


-2.114191261132E+¢1 
~6.243506344448E-62 


-26 
-91 
88 


EM(OUT 


KM 
260 
ADJACENT 
95 93 
76 95 
55 72 
82 
-46 56 
88 -97 
-16 94 
ADJACENT 
-91 80 
-43 --95 
Ad 41 
49 
~12 50 
~42 2 
32-58 
-77 53 
-62 -96 
25-70 
) KS 
1 46 
1 43 
2 66 
1 30 
2 43 
3 63 
1 26 
> 39 
3 52 
4 61 


PRE ERP Pe EE Ee ee BE PE BB BE Ee eee 


PHD SUN RUWUPWEUN DAWU WHEEHEOwWw 
e a . ee 8 e@ o ee oe 8 e @ . oe 
Ot NOR NEF OANBONFDWAUDONAOANADGHRE AGS 


FINAL EIGENVALUES 


2. 825602039426E-01 


EPS 


1.0@E-1¢ 


60 
78 
84 


-96 
-18 
64 


-96 
37 
-57 


53 
-26 
-32 


92 
-14 
-33 


w 


FPRENHEFWE RENEE 


59 
64 
51 


NON-ZERO LOWER DIAGONALS 


NON-ZERO LOWER DIAGONALS 


-92 
-89 
~91 


-56 
-50 
-20 


WNNHENUON NE YI 
s « # 8 8 . 
Swarr uvoe~sos 
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Soin di ae ee ee oe NaANe not ddd eGo. faa] Bet RES Set ere a ee ee ed ee 
wn lot 
fea saat 
= CO rH a 
=) 2S ‘ 
N 
S WO 
Z, CON 
fy hee) 
Oo odo 
H Tr es. 
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ALGORITHM 539 
Basic Linear Algebra Subprograms 
for Fortran Usage [F1] 


C. L. LAWSON 
Jet Propulsion Laboratory 


R. J. HANSON 
Sandia Laboratories, Albuquerque 


D. R. KINCAID 
The University of Texas, Austin 


and 


F. T. KROGH 
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Key Words and Phrases: linear algebra, utilities 
CR Categories: 4.49, 5.14 
Language: Fortran, assembly language 


DESCRIPTION 
This package complements [1], where further details are given. 
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1. Lawson, C.L., Hanson, R.J., KincarD, D.R., AND Krocu, F.T. Basic linear algebra subprograms 
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ALGORITHM 

[The contents of this package consists of four files. The first file contains Fortran 
versions for the BLAS (88 subprograms), programs for testing the BLAS (13 
modules), and 18 subprograms from Brent’s multiple precision package that are 
used in the implementation of the extended precision inner products. The 
remaining 3 files contain Fortran callable assembly language versions for 3 
different machines: IBM 360/370 series, CDC 6000 series, and Univac 1100 series. 
Printed here are the 38 BLAS subprograms. The complete listing is available 
from the ACM Algorithms Distribution Service.] 
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REAL FUNCTION SDOT(N,SX, INCX,SY, INCY) 


RETURNS THE DOT PRODUCT OF SINGLE PRECISION SX AND SY. 
SDOT = SUM FOR I = @ TO N-1 OF SX(LX+I1*INCX) * SY(LY+I*INCY), 
WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 


DEFINED IN A SIMILAR WAY USING INCY. 


REAL SX(1),SY(1) 

SDOT = @.0E@ 

LF(N.LE.@) RETURN 

IF(INCX.EQ.INCY) LF(INCX-1)5,20,6@ 
CONTINUE 


CODE FOR UNEQUAL INCREMENTS OR NONPOSITIVE INCREMENTS. 


5h eae 

Iy=1 

LF (INCX.LT.@) 1X 

LF(INCY.LT.@) LY 

DO 1@ I = 1,N 
SDOT = SDOT + SX(LX)*SY (IY) 
IX = IX + INCX 
IY = LY + INCY 

CONTINUE 

RETURN 


(-N+1)*INCX + 1 
(-N+1)*INCY + 1 


CODE FOR BOTH INCREMENTS EQUAL TO 1 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5. 


M = MOD(N,5) 
IF( M .EQ. @ ) GO TO 4@ 
DO 3@ I = 1,M 
SDOT = SDOT + SX(I)*SY(I) 
CONTINUE 
IF( N .LT. 5 ) RETURN 
MP1 =M+1 
DO 5¢@ I = MP1,N,5 


SDOT = SDOT + SX(I)*SY(I) + SX(ZT + 1)*SY¥(I + 1) + 
SX(I + 2)*SY(I + 2) + SX(I + 3)*SY(I + 3) + SX(I + 4)*SY(I + 4) 


5@ CONTINUE 


RETURN 


CODE FOR POSITIVE EQUAL INCREMENTS .NE.1. 


6@ CONTINUE 


70 


NS=N*INCX 

DO 7@ I=1,NS,INCX 
SDOT = SDOT + SX(I)*SY(I) 
CONTINUE 

RETURN 

END 


DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY) 


RETURNS D.P. DOT PRODUCT ACCUMULATED IN D.P., FOR S.P. SX AND SY 
DSDOT = SUM FOR I = @ TO N-l OF SX(LX+I*INCX) * SY (LY+I*INCY), 
WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 


DEFINED IN A SIMILAR WAY USING INCY. 
REAL SX(1) ,SY(1) 


DSDOT = ¢.D¢ 
LF(N .LE. @) RETURN 
IF(INCX.EQ.INCY.AND.INCX.GT.@) GO TO 2@ 
KX = 1 
KY = 1 
LF(INCX.LT.@) KX = 1+(1-N)*INCX 
IFCINCY.LT.@) KY = 1+(1-N)*INCY 
DO 1@¢ I = 1,N 
DSDOT = DSDOT + DBLE(SX(KX) ) *DBLE (SY (KY) ) 
KX = KX + INCX 
KY = KY + INCY 


SD17430@ 
SD17440 
SD1745¢ 


SD1746@ 
SD17470 
SD1748@ 
SD1749@ 
SD17500 
SD17510 
SD1752@ 
SD17530 
SD17540 
SD17550 
SD17560 
SD17570 
SD17580 
SD1759@ 
SD17600 
SD1761¢ 
SD1762@ 
SD17636 
SD1764@ 
SD1765@ 
SD17660 
SD17676 
SD17680 
SD1769¢@ 
SD1770@ 


SD1772@ 
SD1773¢ 
SD17740 
SD1775@ 
SD17760 
SD17770 
SD1778@ 
SD17796 
SD17860 
SD17810 
SD17820 
SD1783@ 
SD1784@ 
SD1785¢@ 
SD1786@ 
SD178706 
SD1788¢@ 
SD17890 
SD1790¢ 
SD17916 
$D1792@ 


DS1793@ 


DS17970 
DS1798@ 
DS17990 
DS180600 
DS1801¢ 
DS18¢2¢ 
DS1863¢ 
DS180460 
DS18065¢ 
DS1866¢ 
DS18076 
DS1808¢ 
DS18069¢ 
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CONTINUE 

RETURN 

CONTINUE 

NS = N*INCX 
DO 3¢ I=1,NS,INCX 
DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY (I)) 
CONTINUE 

RETURN 

END 


REAL FUNCTION SDSDOT(N,SB,SX, INCX, SY, INCY) 


RETURNS S.P. RESULT WITH DOT PRODUCT ACCUMULATED IN D.P. 


SDSDOT = SB + SUM FOR I = @ TO N-1 OF SX(LX+I*INCX) *SY (LY+1*INCY), 


WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


REAL SX(1) ,SY(1) ,SB 
DOUBLE PRECISION DSDOT 


DSDOT = DBLE(SB) 
IF(N .LE. @) GO TO 3@ 
IF (INCX.EQ. INCY.AND.INCX.GT.@) GO TO 4@ 
KX = 1 
KY = 1 
LF(INCX.LT.@) KX 
IF(INCY.LT.@) KY 
DO 16 I = 1,N 
DSDOT = DSDOT + DBLE(SX(KX) )*DBLE (SY (KY) ) 
KX = KX + INCX 
KY = KY + INCY 
CONTINUE 
SDSDOT = SNGL(DSDOT) 
RETURN 
CONTINUE 
NS = N*INCX 
DO 5@ I=1,NS,INCX 
DSDOT = DSDOT + DBLE(SX(L))*DBLE(SY (1) ) 
CONTINUE 
SDSDOT = SNGL(DSDOT) 
RETURN 
END 


1+(1-N) *INCX 
1+(1-N) *INCY 


DOUBLE PRECISION FUNCTION DDOT(N,DX, INCX, DY, INCY) 


RETURNS THE DOT PRODUCT OF DOUBLE PRECISION DX AND DY. 

DDOT = SUM FOR I = @ TO N-1 OF DX(LX+I*INCX) * DY (LY+I*INCY) 
WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


DOUBLE PRECISION DX(1) ,DY(1) 

DDOT = @.D¢ 

IF(N.LE.@) RETURN 

IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60 
CONTINUE 


CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS. 


Ix =1 
Iy=1 
LF(INCX.LT.@) 1X 
LF (INCY.LT.6) IY 
DO 16 I = 1,N 
DDOT = DDOT + DX(IX)*DY (IY) 
IX = IX + INCX 
IY = IY + INCY 
CONTINUE 
RETURN 


(-N+1)*INCX + 1 
(-N+1)*INCY + 1 


CODE FOR BOTH INCREMENTS EQUAL TO 1. 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5. 


DS1810¢0 
DS1811¢@ 
DS1812¢ 
DS1813¢ 
DS1814@ 
DS1815¢@ 
DS1816@ 
DS1817¢ 
DS1818¢@ 


SD18190 


SD18240 
SD1825@ 
SD18260@ 
SD18270 
SD1828¢@ 
SD1829@ 
SD1830@ 
SD1831@ 
SD18320 
SD18330 
SD18340 
SD18350@ 
SD18360 
SD18370@ 
SD18380 
SD18390 
SD1840@ 
SD1841¢@ 
SD18420 
SD1843¢ 
SD18440 
SD18450 
SD18460 
SD18470 
SD1848@ 


DD18490 
DD18500 
DD1851¢@ 


DD18520@ 
DD18530@ 
DD18540@ 
DD1855@ 
DD1856@ 
DD18570@ 
DD18580 
DD1859¢0 
DD1860@ 
DD18610 
DD18620 
DD1863@ 
DD1864@ 
DD18650@ 
DD186606 
DD18670 
DD1868¢@ 
DD1869¢ 
DD1870@ 
DD1871@ 
DD1872¢ 
DD18736 
DD18746 
DD1875@ 
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= MOD(N, 5) 
FC M .EQ. @ ) GO TO 4¢ 
DO 36 I = 1,M 
DDOT = DDOT + DX(I)*DY (I) 
CONTINUE 
IF( N .LT. 5 ) RETURN 
MPl=M+1 
DO 5@ I = MP1,N,5 
DDOT = DDOT + DX(1)*DY(L) + DX(I+1)*DY(I+1) + 
2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4) 


+h Ww + 


CONTINUE 
RETURN 


CODE FOR POSITIVE EQUAL INCREMENTS .NE.1. 


CONTINUE 

NS = N*INCX 
DO 74 I=1,NC,1INCY 
DDOT = DDOT + DX(I)*DY(I) 
CONTINUE 

RETURN 

END 


DOUBLE PRECISION FUNCTION DQDOTA(N,DB,QC,Dx, INCX,DY, INCY) 
D.P. DOT PRODUCT WITH EXTENDED PRECISION ACCUMULATION (AND RESULT) 
QC AND DQDOTA ARE SET = DB + QC + SUM FOR I = @ TO N-1 OF 
DX(LX+I*INCX) * DY(LY+I*INCY), WHERE QC IS AN EXTENDED 
PRECISION RESULT PREVIOUSLY COMPUTED BY DQDOTI OR DQDOTA 
AND LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. THE MP PACKAGE BY 
RICHARD P. BRENT IS USED FOR THE EXTENDED PRECISION ARITHMETIC. 


FRED T. KROGH, JPL, 1977, JUNE 1 


DOUBLE PRECISION DX(1), DY(1), DB 

INTEGER QC(16), QX(16), QY(1¢) 

THE COMMON BLOCK FOR THE MP PACKAGE (MODIFIED TO GIVE IT A NAME) 
COMMON /MPCOM/ MPB, MPT, MPM, MPLUN, MPMKR, MPR(12) 

DATA I1/@/ . 

IF Il IS @ THE MP PACKAGE MUST BE INITIALIZED (MPBLAS SETS Il = 1) 
IF (I1 .EQ. 6) CALL MPBLAS(I1) 

IF (DB .EQ. $.D@) GO TO 2¢ 

CALL MPCDM(DB, QX) 

CALL MPADD(QC, QX, QC) 

IF (N .EQ. 6) GO TO 40 


IF (INCX .LT. @) IX 

IF (INCY .LT. @) IY 

DO 3¢@ I= 1,N 
CALL MPCDM(DX(IX), QX) 
CALL MPCDM(DY (IY), QY) 
CALL MPMUL(QX, QY, QX) 
CALL MPADD(QC, QX, QC) 
IX = IX + INCX 
TY = IY + INCY 

CONTINUE 

CALL MPCMD(QC, DQDOTA) 

RETURN 

END 


(-N + 1) * INCK +1 
(-N +1) * INCY +1 


COMPLEX FUNCTION CDOTC(N,CX, INCX,CY, INCY) 


RETURNS THE DOT PRODUCT FOR COMPLEX CX AND CY, USES CONJUGATE (CX) 
CDOTC = SUM FOR I = @ TO N-1 OF CONJ(CX(LX+I*INCX) ) *CY (LY+I*INCY) , 
WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


COMPLEX CX(1) ,CY(1) 
CDOTC = (@.,@.) 


IF(N .LE. @)RETURN 
IFCINCX.EQ.INCY..AND.INCX.GT.@) GO TO 2@ 


DD1876¢6 


DD1878¢@ 
DD1879¢ 
DD188¢0 
DD1881¢6 
DD1882¢ 
DD1883¢6 
DD1884¢ 
DD1885¢ 
DD18860 
DD1887@ 
DD1888¢ 
DD1889¢ 
DD1890@ 
DD1891¢ 
DD1892¢ 
DD18930 
DD18946 
DD1895¢6 
DD1896¢@ 
DD1897@ 
DD1898¢ 


CD1978¢ 


CD1982¢@ 
CD19830 
CD19840 
CD1985¢ 
CD1986¢ 
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KX = 1 
KY = 1 
IF(INCX.L’.@) KX 
LF(INCY.LT.@) KY 
DO 16 I = 1,N 
CDOTC = CDOTC + CONJG(CX(KX) ) *CY (KY) 
KX = KX + INCX 
KY = KY + INCY 
CONTINUE 
RETURN 
CONTINUE 
NS = N*INCX 
DO 36 I=1,NS,INCX 
CDOTC = CONJG(CX(I))*CY(I) + CDOTC 
CONTINUE 
RETURN 
END 


1+ (1-N) *INCX 
1+(1-N) *INCY 


COMPLEX FUNCTION CDOTU(N,CX, INCX,CY,INCY) 


RETURNS THE DOT PRODUCT FOR COMPLEX CX AND CY, NO CONJUGATION 
CDOTU = SUM FOR I = @ TO N-1 OF CX(LX+I*INCX) * CY(LY+I*INCY), 
WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)4*N, AND LY IS 


DEFINED IN A SIMILAR WAY USING INCY. 
COMPLEX CX(1) ,cY (1) 


CDOTU = (@.,@.) 
IF(N .LE. 6)RETURN 
IF (INCX.EQ.INCY.AND.INCX.GT.@) GO TO 2@¢ 
KX = 1 
KY = 1 ’ 
IF(INCX.LT.@) KX 
IF(INCY.LT.@) KY 
DO 10 I = 1,N 
CDOTU = CDOTU + CX(KX)*CY (KY) 
KX = KX + INCX 
KY = KY + INCY 
CONTINUE 
RETURN 
CONTINUE 
NS = N*INCX 
DO 3@ I=1,NS,INCX 
CDOTU = CDOTU + CX(I)*CY (I) 
CONTINUE 
RETURN 
END 


1+(1-N) *INCX 
1+ (1-N) *INCY 


SUBROUTINE SAXPY(N,SA,SX, INCX,SY, INCY) 


OVERWRITE SINGLE PRECISION SY WITH SINGLE PRECISION SA*SX +SY. 

FOR I = @ TO N-1, REPLACE SY(LY+I*INCY) WITH SA*SX(LX+I*INCX) + 
SY(LY+I*INCY), WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)4N, 
AND LY IS DEFINED IN A SIMILAR WAY USING INCY. 


REAL SX(1),SY(1),SA 
LF(N.LE.@.0R.SA.EQ.0.E@) RETURN 
IF(INCX.EQ.INCY) IF(INCX-1) 5,2@,6¢ 


CONTINUE 
CODE FOR NONEQUAL OR NONPOSITIVE INCREMENTS. 

IX = 1 
Iy=1 
IF(INCX.LT.@)IX = (-N+1)*INCX + 1 
IF(INCY.LT.@)IY = (-N+1)*INCY + 1 
DO 16 I = 1,N 

SY(IY) = SY(IY) + SA*SX(IX) 

IX = IX + INCX 

IY = LY + INCY 
CONTINUE 
RETURN 


CD1987@ 
CD19886 
CD19899@ 
CD19960 
CD1991¢ 
CD19920 
CD19930 
CD19940@ 
CD1995@ 
CD19960@ 
CD1997@ 
CD19980 
CD1999¢@ 
CD20000 
CD2001¢ 
CD29620 
CD20¢63¢@ 


CD26640 


CD2008¢ 
CD2609¢ 
CD296160 
CD2@110 
CD26129 
CD2013@ 
CD2914¢ 
CD2015@ 
CD2016¢ 
CD2@170 
CD2618¢ 
CD2@190 
CD2020¢ 
CD20210 
CD20220 
CD26230@ 
CD2024@ 
CD26250 
CD2626¢ 
CD20270 
CD2628¢0 
CD2629¢ 


SA20300 
SA203106 
SA203206 


SA2033@ 
SA2034@ 
SA2035@ 
SA20360 
SA2037@ 
SA2038@ 
SA20390 
SA204066 
SA20410 
SA20420 
SA20430 
SA20446 
SA2045@ 
SA20460 


SA20476: 


SA20486 
SA20490 
SA205060 
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CO OF Coy 


20 M = MOD(N 
IF( M .EQ 
DO 34 I = 

SY(I) = 


CODE FOR BOTH INCREMENTS EQUAL TO 1 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 4. 


»4) 

. 6 ) GO TO 46 
1,M 

SY(I) + SA*SX(I) 


C 
C 


C 


ra?) 


=] 


a 


a 


Ls 


aa 


aaa 


Ch 42) 3 


30 CONTINUE 
IF( N .LT. 4 ) RETURN 


DO 5@ I = MP1,N,4 

= SY(I) + SA*SX(I) 
SY(I + 1) + SA*SX(I + 1) 
SY(I + 2) + SA*SX(I + 2) 
SY(I + 3) + SA*SX(I + 3) 


ww 
K 
ran 
re 
+ 
wo 
ww 
u 


5@ CONTINUE 
RETURN 


CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS. 


6@ CONTINUE 
NS = N*INCX 
DO 76 I=1,NS,INCX 
SY(L) = SA*SX(I) + SY(T) 
79 CONTINUE 
RETURN 
END 


SUBROUTINE DAXPY (N,DA,DX, INCX, DY, INCY) 


OVERWRITE DOUBLE PRECISION DY WITH DOUBLE PRECISION DA*DX + DY. 
FOR I = @ TO N-1, REPLACE DY(LY+I*INCY) WITH DA*DX(LX+I*INCX) + 
DY (LY+I*INCY), WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, 


AND LY IS DEFINED IN A SIMILAR WAY USING INCY. 


DOUBLE PRECISION DX(1),DY(1),DA 

LF(N.LE.@.OR.DA.EQ.@.DQ@) RETURN 

IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60@ 
5 CONTINUE 


CODE FOR NONEQUAL OR NONPOSITIVE INCREMENTS. 


Ix = 1 

Iy=1 

IF(INCX.LT.0) IX 

IF (INCY.LT.@) IY 

DO 16 I = 1,N 
DY(IY) = DY(IY) + DA*DX(IX) 
IX = LX + INCX 
IY = LY + INCY 

10 CONTINUE 
RETURN 


(-N+1)*INCX + 1 
(-N+1)*INCY + 1 


CODE FOR BOTH INCREMENTS EQUAL TO 1 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 4. 


20 M = MOD(N,4) 
IF( M .EQ. @ ) GO TO 4@ 
DO 36 I = 1,M 


DY(I) = DY(I). + DA*DX(I) 
30 CONTINUE 
IF( N .LT. 4 ) RETURN 
49 MP1 = M+1 
DO 5¢@ I = MP1,N,4 
DY(I) = DY(I) + DA*DX(I) 
DY(I + 1) = DY(I + 1) + DA*DX(I + 1) 
DY(I + 2) = DY(1 + 2) + DA*DX(I + 2) 
DY(I + 3) = DY(I + 3) + DA*DX(I + 3) 
59 CONTINUE 


SA20510 
SA20520 
SA20530 
SA20540 
SA20550 
SA20566 


SA2058@ 
SA20599 
SA20600 
SA20610 
SA20620 
SA20630 
SA20640 
SA20650 
SA20660 
SA20670 
SA29680 
SA20690 
SA20700 
SA20710 
SA20720 
SA20730 
SA20740 
SA20750 
SA20760 
SA20770 
SA20780 
SA20790 
SA26800 


DA268190 
DA20682@ 
DA2@83¢0 


DA2@846 
DA2@850 
DA20860 
DA26876 
DA2088¢ 
DA2089¢ 
DA2G960 
DA2091¢ 
DA2692@ 
DA2693@ 
DA2G94@ 
DA2695@ 
DA29960 
DA20970 
DA20980 
DA26990 
DA21000 
DA2101¢ 
DA21620 
DA2103@ 
DA2104@ 
DA21050 
DA21060 
DA210670 


DA21690 
DA21100 


DA2111@ 
DA2112@ 
DA21130 
DA2114@ 
DA2115¢@ 
DA2116@ 
DA211706 
DA2118@ 
DA2119¢ 
DA2126¢ 
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RETURN 
C 
C CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS. 
C 
60 CONTINUE 
NS = N*INCX 
DO 76 I=1,NS,INCX 
DY(I) = DA*DX(I) + DY(I) 
7@ CONTINUE 

RETURN 

END 

SUBROUTINE CAXPY (N,CA,CX, INCX, CY, INCY) 
Cc 
C OVERWRITE COMPLEX CY WITH COMPLEX CA*CX + CY. 
C FOR I = @ TO N-1, REPLACE CY(LY+I*INCY) WITH CA*CX(LX+I*INCX) + 
c CY (LY+I*INCY), WHERE LX = 1 IF INCX .GE. 6, ELSE LX = (-INCX)&*N, 
Cc AND LY IS DEFINED IN A SIMILAR WAY USING INCY. 
C 

COMPLEX CX(1),CY(1),CA 
Cc 


CANORM = ABS(REAL(CA)) + ABS (AIMAG(CA)) 
IF(N.LE.@.OR.CANORM.EQ.@.E@) RETURN 
IF (INCX.EQ.INCY.AND.INCX.GT.@) GO TO 20 
KX = 1 
KY = 1 
LF(INCX.LT.O) KX 
LF(INCY.LT.O) KY 
DO 19 I = 1,N 
CY (KY) = CY(KY) + CA*CX(KX) 
KX = KX + INCX 
KY = KY + INCY 
1@ CONTINUE 
RETURN 
2¢ CONTINUE 
NS = N*INCX 
DO 3¢ I=1,NS,INCX 
CY(I) = CA*CX(L) + CY(I) 
30 CONTINUE 
RETURN 
END 


1+ (1-N) *INCX 
1+(1-N) *INCY 


SUBROUTINE SROTG(SA,SB,SC,SS) 


DESIGNED BY C.L.LAWSON, JPL, 1977 SEPT 68 


CONSTRUCT THE GIVENS TRANSFORMATION 


G= ( - SCk*2 + SS*#*#2 = 1, 


WHICH ZEROS THE SECOND ENTRY OF THE 2-VECTOR (SA,SB)**T . 


THE QUANTITY R = (+/-)SQRT(SA**2 + SB**2) OVERWRITES SA IN 
STORAGE. THE VALUE OF SB IS OVERWRITTEN BY A VALUE Z WHICH 
ALLOWS SC AND SS TO BE RECOVERED BY THE FOLLOWING ALGORITHM: 

IF Z=1 SET SC=@. AND SS=1. 

IF ABS(Z) .LT. 1 SET SC=SQRT(1-Z**2) AND SS=Z 

IF ABS(Z) .GT. 1 SET SC=1/Z AND SS=SQRT(1-SC**2) 


NORMALLY, THE SUBPROGRAM SROT(N,SX,INCX,SY,INCY,SC,SS) WILL 
NEXT BE CALLED TO APPLY THE TRANSFORMATION TO A 2.BY N MATRIX. 


a a i es a ee re a es ee ce ne a ee a ee a ee ee ee ew ey ee ee ee cS ee es en ee oe cee oe 


GSAOAOAO MAGA AAADMAARoaANnAoAaA a4 


IF (ABS(SA) .LE. ABS(SB)})} GO To 19 


Cc 
C *** HERE ABS(SA) .GT. ABS(SB) *** 
GC 

U = SA + SA 

v= SB / U 


DA2121¢ 
DA212206 
DA2123¢@ 
DA2124@ 
DA2125@ 
DA2126@ 
DA2127@ 
DA21286 
DA2129@ 
DA2130@ 
DA2131¢ 


CA21320 


CA21360 
CA21370@ 
CA21380 
CA2139@ 
CA21406 
CA2141@ 
CA21420 
CA21430 
CA21440 
CA2145@ 
CA21460 
CA2147@ 
CA2148@ 
CA2149¢ 
CA2150@ 
CA21510 
CA21520 
CA2153@ 
CA21540 
CA2155@ 
CA21560 
CA21570 
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C 
Cc 


aaa o] 


aaa 


aaa 


AOMAANAAAAAANRnDANANAAAAANNAAANAANA 


aa 


RK 


16 


RK 


REX 


NOTE THAT U AND R HAVE THE SIGN OF SA 
R = SQRT(.25 + V**2) * U 


NOTE THAT SC IS POSITIVE 


SC = SA/R 

SS = V * (SC + SC) 
SB = SS 

SA =R 

RETURN 


HERE ABS(SA) .LE. ABS(SB) *** 


IF (SB .EQ. @.) GO TO 26 
U = SB + SB 
V=SA/U 


NOTE THAT U AND R HAVE THE SIGN OF SB 
(R IS IMMEDIATELY STORED IN SA) 


SA = SQRT(.25 + V**2) * U 
NOTE THAT SS IS POSITIVE 


SS = SB / SA 

Sc = V * (SS + SS) 

IF (SC .EQ. @.) GO TO 15 
SB=1. / SC 

RETURN 

SB=1. 

RETURN 


HERE SA = SB = @. *k* 


SUBROUTINE DROTG(DA,DB,DC,DS) 


DESIGNED BY C.L.LAWSON, JPL, 1977 SEPT 68 


CONSTRUCT THE GIVENS TRANSFORMATION 


(pc DS ) 
G = ( ),  DCk*2 + DS**2 = 1, 
(-DS DC ) 


WHICH ZEROS THE SECOND ENTRY OF THE 2-VECTOR (DA,DB)*4T . 


THE QUANTITY R = (+/-)DSQRT(DA**2 + DB**2) OVERWRITES DA IN 
STORAGE. THE VALUE OF DB IS OVERWRITTEN BY A VALUE Z. WHICH 
ALLOWS DC AND DS TO BE RECOVERED BY THE FOLLOWING ALGORITHM: 
IF Z=1 SET DC=@.D@ AND DS=1.D0 
IF DABS(Z) .LT. 1 SET DC=DSQRT(1-Z**2) AND DS=Z 
IF DABS(Z) .GT. 1 SET DC=1/Z AND DS=DSQRT(1-DC**2) 


NORMALLY, THE SUBPROGRAM DROT(N,DX,INCX,DY,INCY,DC,DS) WILL 
NEXT BE CALLED TO APPLY THE TRANSFORMATION TO A 2 BY N MATRIX. 


DOUBLE PRECISION DA, DB, DC, DS, U, V, R 
IF (DABS(DA) .LE. DABS(DB)) GO TO 10 


HERE DABS(DA) .GT. DABS(DB) *** 
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aaa 


aaa 


aaan aaa 


aang 


aaa 


aaan 


U 
Vv 


DA + DA 
DB / U 


NOTE THAT U AND R HAVE THE SIGN OF DA 
R = DSQRT(.25D@ + V**2) * U 


NOTE THAT DC IS POSITIVE 


DC = DA/R 

DS = V * (DC + DC) 
DB = DS 

DA =R 

RETURN 


*** HERE DABS(DA) .LE. DABS(DB) *** 


1@ IF (DB .EQ. @.D@) GO TO 2¢ 
U = DB + DB 
V=DA/U 


NOTE THAT U AND R HAVE THE SIGN OF DB 
(R IS IMMEDIATELY STORED IN DA) 


DA = DSQRT(.25D@ + V**2) * U 
NOTE THAT DS IS POSITIVE 


DS = DB / DA 

DC = V * (DS + DS) 

IF (DC .EQ. @.D@) GO TO 15 
DB = 1.D¢@ / DC 


15 DB = 1.D¢ 


**k* HERE DA = DB = @.D@ *** 


2@ DC = 1.D¢ 
DS = @.D¢ 


SUBROUTINE SROT(N,SX, INCX,SY, INCY,SC,SS) 


MULTIPLY THE 2 X 2 MATRIX ( SC SS) TIMES THE 2 X N MATRIX (SX**T) 
(~SS SC) (SY**T) 
WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN 


SX(LX+I*INCX), I = @ TO N-1, WHERE LX = 1 IF INCX .GE. @, ELSE 
LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. 

REAL SX,SY,SC,SS,ZERO,ONE,W,Z 

DIMENSION $X(1),SY(1) 


DATA ZERO,ONE/@.E@,1.E@/ 
IF(N .LE. @ .OR. (SS .EQ. ZERO .AND. SC .EQ. ONE)) GO TO 4@ 
IF(.NOT. (INCX .EQ. INCY .AND. INCX .GT. 6)) GO TO 2¢ 


NSTEPS=INCX*N 

DO 1@ I=1,NSTEPS, INCX 
W=SX(LI) 
Z=SY (I) 
SX(1)=SC*#W+SS*Z 
SY (L)=-SS*W+SC*Z 


1¢ CONTINUE 
GO TO 4¢ 

2@ CONTINUE 
KX=1 
KY=1 


IFC(INCX .LT. 6) KX=1-(N-1) *INCX 
IFC(INCY .LT. 6) KY=1-(N-1)*INCY 


SR24216 
SR24226 


SR24266 
SR24276 
SR24286 
SR24290 
SR2436¢6 
SR2431¢ 
SR2432@ 
SR24336@ 
SR24340 
SR24356 
SR24360 
SR24376 
SR243806 
SR24390 
SR24400 
SR24410 
SR24446 
SR24456 
SR24460 
SR24476@ 
SR24486 
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ra 
Aa 


OQAQANRAANANAAAaAN 


30 
AQ 


10 


20 


30 
40 


DO 3@ I=1,N 
W=SX (KX) 
7=SY (KY) 
SX (KX) =SC*W+SS4Z 
SY (KY) =-SS*W+SC*Z 


KX=KX+INCX 
KY=KY+INCY 
CONTINUE 

CONTINUE 

RETURN 

END 


SUBROUTINE DROT(N,DX, INCX,DY,INCY,DC,DS) 


MULTIPLY THE 2 X 2 MATRIX 
(-DS DC) 

WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN 

DX(LX+I*INCX), I = @ TO N-1, WHERE LX = 1 IF INCX .GE. @, ELSE 

LX = (-INCX)*N, AND SIMILARLY FOR DY USING LY AND INCY. 

DOUBLE PRECISION DX,DY,DC,DS,ZERO,ONE,W,Z 

DIMENSION DX(1) ,DY (1) 


DATA ZERO,ONE/@.D¢,1.D0/ 
LF(N .LE. @ .OR. (DS .EQ. ZERO .AND. DC .EQ. ONE)) GO TO 46 


IF(.NOT. (INCX .EQ. INCY .AND. INCX .GT. @)) GO TO 26 


NSTEPS=INCX4N 
DO 1@ I=1,NSTEPS,INCX 


W=DX (I) 
Z=DY (1) 
DX (L)=DC*W+DS*Z 
DY (L)=-DS*W+DC*Z 
CONTINUE 
GO TO 4¢ 
CONTINUE 
KX=1 
KY=1 
LF(INCX .LT. @) KX=1-(N-1)*INCX 
LF(INCY .LT. @) KY=1-(N-1)*INCY 
DO 30 I=1,N 
W=DX (KX) 
Z=DY (KY) 
DX (KX) =DC*W+DS4Z 
DY (KY) =-DS*W+DC*Z 
KX=KX+INCX 
KY=KY+INCY 
. CONTINUE 
CONTINUE 
RETURN 
END 


SUBROUTINE SROTMG (SD1,SD2,SX1,SY1, SPARAM) 


CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS 
(SQRT (SD1)*SX1,SQRT (SD2)* 


THE SECOND COMPONENT OF THE 2-VECTOR 
SY2) **T. 
WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. 


SFLAG=-1.E@ SFLAG=0.E@ SFLAG=1.E@ SFLAG=-2.E@ 
(SH11 SH12) (1.E@ SH12) (SH11 1.EQ) (1.EO @.EQ) 

H= ( ) ( ) ( ) ( ) 
(SH21 SH22), (SH21 1.E@), (-1.E@ SH22), (0.E@ 1.E0). 


LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 
RESPECTIVELY. (VALUES OF 1.E@, -1.E@, OR @.E@ IMPLIED BY THE 


( DC DS) TIMES THE 2 X N MATRIX (DX**T) 
(DY**T) 


SR24490 
SR24500 
SR24519 
SR24520 
SR24530 
SR24540 
SR24550 
SR24560 
SR24570 
SR24580 
SR2459@ 
SR24600 
SR24616 


DR24620 
DR2463¢ 


DR24670 
DR24680 
DR24690 
DR247060 
DR24710 
DR2472@ 


DR24730 
DR24746 
DR2475@ 
DR24766 
DR24770 
DR24780@ 
DR24790 
DR248060 
DR24810 
DR24826 
DR2483@ 
DR2484@ 
DR2485¢ 
DR2486¢6 
DR2487@ 
DR24880 
DR2489@ 
DR2496@ 
DR2491@ 
DR2492¢ 
DR2493@ 
DR2494@ 
DR24950@ 
DR24960 
DR2497 
DR2498@ 
DR249960 
DR25000 
DR2561¢ 


SROGOO1O 
SROGGO26 
SROOGO30 
SROGGO40 
SROOOO5O 
SROGGO6O 
SROOOO7G 
SROGOD8O 
SROOGGID 
SROOG100 
SROOGO110 
SROOG126 
SROOG130 
SROOO140 
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ek Map ae ae a a | 


10 


20 


30 


4g 


50 


79 


VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) 


THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE 
INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE 
OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. 


DIMENSION SPARAM(5) 


DATA ZERO,ONE,TWO /@.E@,1.E@,2.E@/ 
DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/ 
IF(.NOT. SD1 .LT. ZERO) GO TO 10 
GO ZERO-H-D--AND-SX1.. 
GO TO 6¢ 
CONTINUE 
CASE~SD1-NONNEGATIVE 
SP2=SD2*SY1 
IF(.NOT. SP2 .EQ. ZERO) GO TO 26 
SFLAG=—TWO 
GO TO 260 
REGULAR-CASE. . 
CONTINUE 
SP1=SD1*SX1 
SQ2=SP2*SY1 
SQ1=SP1*SX1 


IF(.NOT. ABS(SQ1) .GT. ABS(SQ2)) GO TO 4¢ 
SH21=-SY1/SX1 
SH12=SP2/SP1 
SU=ONE~SH12*SH21 


IF(.NOT. SU .LE. ZERO) GO TO 30 
GO ZERO-H-D-AND-SX1.. 


GO TO 6¢ 
CONTINUE 
SFLAG=ZERO 
SD1=SD1/SU 
SD2=SD2/SU 
SX1=SX1*SU 
GO SCALE-CHECK.. 
GO TO 166 
CONTINUE 
IF(.NOT. SQ2 .LT. ZERO) GO TO 5@ 
GO ZERO-H-D-AND-SX1.. 
GO TO 60 
CONTINUE 
SFLAG=ONE 


SH11=SP1/SP2 
SH22=SX1/SY1 
SU=ONE+SH11*SH22 
STEMP=SD2/SU 
SD2=SD1/SU 
SD1=STEMP 
SX1=SY1*SU 

GO SCALE-CHECK 
GO TO 100 

PROCEDURE. .ZERO-H-D-AND-SX1.. 


6 CONTINUE 


SFLAG=-ONE 
SH11=ZERO 
SH12=ZERO 
SH21=ZERO 
SH22=ZERO 


SD1=ZERO 
SD2=ZERO 
SX1=ZERO 
RETURN... 
GO TO 229 
PROCEDURE. .FIX-H.. 
CONTINUE 
IF(.NOT. SFLAG .GE. ZERO) GO TO 9¢ 


IF(.NOT. SFLAG .EQ. ZERO) GO TO 8@ 
SH11=ONE 
SH22=ONE 


SROOG15O 
SROGOGO16¢6 
SROGOG17¢6 
SROOO180 
SROOG190 
SROOO200 
SROOG21¢ 
SROOG220 
SROOO2 36 
SROOO240 
SROGO250 
SROOO266 
SROOO270 
SROGG286 
SROOG290 
SROOO300 
SROOO31@ 
SROOO320 
SROOO330 
SROGO340 
SROGO350 
SROGO360 
SROGO370 
SROGOG38¢ 
SROGO390 
SROGO49O 
SROOO410 
SROOO420 
SROGO4 30 
SROGO446 
SROOO456 
SROOG460 
SROOO470 
SROGO48O 
SROOG49O 
SROOO500 
SROGO516 
SROOG520 
SROGO5 30 
SROOG54G 
SROGO556 
SROGO560 
SROOO570 
SROOG586 
SROOO590 
SROGGHOO 
SROOG616 
SROOG620 
SROOG630 
SROOG64O 
SROOG650 
SROOO660 
SROGO67¢ 
SROOG68O 
SROGG69O 
SROGO79O 
SROOG710 
SROOG72¢ 
SROGO7 30 
SROOO746 
SROGO750 
SROGO760 
SROOO770 
SROGO780 
SROGO79O 
SROOO8OG6 
SROGO810 
SROOG820 
SROGO8 30 
SROGO840 
SROGO850 
SROOG860 
SROOG870 


SROOO88G 
SKOGO890 


SROGOIDD 
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Cc 


SFLAG=—ONE 
GO TO 9¢ 
80 CONTINUE 
SH21=-ONE 
SH12=ONE 
SFLAG=-ONE 
9% CONTINUE 
GO TO IGO, (124,154, 18@, 21) 
PROCEDURE. . SCALE-CHECK 
100 CONTINUE 
116 CONTINUE 


IF(.NOT. SD1 .LE. RGAMSQ) GO TO 13@ 
IF(SD1 .EQ. ZERO) GO TO 16¢ 


ASSIGN 12@ TO IGO 
FIX-H.. 
GO TO 7¢ 

126 CONTINUE 
SD1=SD1*GAM**2 
SX1=SX1/GAM 
SH11=SH11/GAM 
SH12=SH12/GAM 

GO TO 11¢ 
13@ CONTINUE 
146 CONTINUE 


IF(.NOT. SD1 .GE. GAMSQ) GO TO 16¢ 


ASSIGN 15@ TO IGO 
FIX-H.. 
GO TO 7@ 

150 CONTINUE 
SD1=SD1/GAM**2 
SX1=SX1*GAM 
SH11=SH11*GAM 
SH12=SH12*GAM 

GO TO 14@ 
16@ CONTINUE 
176 CONTINUE 


IF(.NOT. ABS(SD2) .LE. RGAMSQ) GO TO 190 
IF(SD2 .EQ. ZERO) GO TO 220 


ASSIGN 18@ TO IGO 
FIX-H.. 
GO TO 7@¢ 

18¢ CONTINUE 
SD2=SD2*GAM**2 
SH21=SH21/GAM 
SH22=SH22/GAM 

GO TO 17@ 
19% CONTINUE 
200 CONTINUE 


IF(.NOT. ABS(SD2) .GE. GAMSQ) GO TO 226 


ASSIGN 2106 TO IGO 
FIX-H.. 
GO TO 7¢ 
210 CONTINUE 
SD2=SD2/GAM**2 
SH21=SH21*GAM 
SH22=SH22*GAM 
GO TO 2¢@ 
22@ CONTINUE 
LF(SFLAG) 250, 230, 246 
230 CONTINUE 
SPARAM(3)=SH21 
SPARAM(4)=SH12 
GO TO 269 
246 CONTINUE 
SPARAM(2)=SH11 
SPARAM(5)=SH22 
GO TO 26¢ 
250 CONTINUE 
SPARAM(2)=SH11 
SPARAM(3)=SH21 
SPARAM(4)=SH12 
SPARAM(5)=SH22 
26@ CONTINUE 
SPARAM(1)=SFLAG 
RETURN 
END 


SROGO910 
SROOG926 
SROGG930 
SROOG940 
SROGG950 
SROGG960 
SROGG97@ 
SROOO980 
SROGG99@ 
SROG1000 
SROG10610 
SROG1020 
SROO1630 
SRO@1640 
SROG165¢ 
SROO1060 
SROO10670 
SROO1080 
SROG1090 
SROGO1160 
SROO1110 
SROG112¢ 
SROO1130 
SROG1146 
SROO115¢ 
SROG1160 
SRO@1170 
SROO1180 
SROG1196 
SROG1260 
SROO1210 
SROG1220 
SROO1230 
SROG1240 
SROG125¢ 
SROO126¢ 
SRO@1270 
SROG128¢ 
SROG1290 
SROGO1360 
SRO@1310 
SRO@132¢6 
SROG1330 
SROG1340 
SROO1350 
SROO1360 
SROO1376 
SROG1386 
SROG1396 
SROG1460 
SRO@1410 
SROO142@ 
SROG1430 
SROO1446 
SROO1450 
SROO1460 
SRO@147¢ 
SROG1480 
SROG1490 
SROO15066 
SRO@1510 
SROO152¢ 
SROO1530 
SROG1546 
SRO@1550 
SRO@156¢ 
SRO@1570 
SROO1580 
SROO159@ 
SROG1600 
SROG161¢ 
SROO1620 
SROO1630 
SROG1646 
SROO165¢@ 
SROG166¢@ 
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1¢ 


2 


30 


49 


50 


SUBROUTINE DROIMG (DD1,DD2,DX1,DY1,DPARAM) 


CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS 
(DSQRT (DD1) *DX1, DSQRT (DD2) * 


THE SECOND COMPONENT OF THE 2-VECTOR 
DY2)*4T. 
WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. 


DFLAG=-1.D@ DFLAG=0.D@ DFLAG=1.D@ DFLAG=-2.D@ 
(DH11 DH12) (1.D@ DH12) (DH11 1.D@) (1.D6 @.DO) 

H=( ) ( ) ( ) ( ) 
(DH21 DH22), (DH21 1.D0), (-1.D@ DH22), (@.D@ 1.D0). 


LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 
RESPECTIVELY. (VALUES OF 1.D@, -1.D¢, OR @.D@ IMPLIED BY THE 
VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) 


THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE 
INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE 
OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. 


DOUBLE PRECISION GAM,ONE,RGAMSQ,DD2,DH11,DH21,DPARAM, DP2, 
1 DQ2,DU,DY1, ZERO, GAMSQ, DD1, DFLAG, DH12, DH22, DP1,DQ1, 

2 DTEMP ,DX1,TWO 

DIMENSION DPARAM(5) 


DATA ZERO,ONE,TWO /@.D@,1.D@,2.D0/ 
DATA GAM,GAMSQ,RGAMSQ/4@96.D@, 16777216.D0, 5.9604645D-8/ 
IF(.NOT. DD1 .LT. ZERO) GO TO 1¢ 
GO ZERO-H-D-AND-DX1.. 
GO TO 6¢ 
CONTINUE 
CASE-DD1-NONNEGATIVE 
DP2=DD2*DY1 
IF(.NOT. DP2 .EQ. ZERO) GO TO 20 
DFLAG=-TWO 
GO TO 260 
REGULAR-CASE. . 
CONTINUE 
DP1=DD1*DX1 
DQ2=DP2*DY1 
DQ1=DP1*DX1 


IF(.NOT. DABS(DQ1) .GT. DABS(DQ2)) GO TO 4@ 
DH21=-DY1/DX1 
DH12=DP2/DP1 
DU=ONE-DH12*DH21 


IF(.NOT. DU .LE. ZERO) GO TO 3¢ 
GO ZERO-H-D-AND-DX1. . 


GO TO 6¢ 
CONTINUE 
DFLAG=ZERO 
DD1=DD1/DU 
DD2=DD2/DU 
DX1=DX1*DU 
GO SCALE-CHECK. . 
GO TO 1¢¢ 
CONTINUE 
IF(.NOT. DQ2 .LT. ZERO) GO TO 5@ 
GO ZERO-H-D-AND-DX1.. 
GO TO 60 
CONTINUE 
DFLAG=ONE 


DH11=DP1/DP2 
DH22=DX1/DY1 
DU=ONE+DH11*DH22 
DTEMP=DD2/DU 
DD2=DD1/DU 
DD1=DTEMP 
DX1=DY1*DU 
GO SCALE-CHECK 

GO TO 100 

PROCEDURE. . ZERO-H-D-AND-DX1. . 


66 CONTINUE 


DFLAG=-ONE ° 


DROGOG10 
DROOGO20 
DROGGO36 
DROGOO4G 
DROOGO5O 
DROOOGEO 
DROOOO7O 
DROOGG8O 
DROOOGIO 
DROGG1960 
DROOO11¢6 
DROGO120 
DROOO130 
DROGO140 
DROOO15O 
DROGG16¢ 
DROOG170 
DROOO180 
DROOO196 
DROOG200 
DROOG210 
DRO@O226 
DROOG230 
DROOO240 
DROOO250 
DROOG266 
DROOG276 
DROGO280 
DROGG290 
DROGO300 
DROOO316 
DROGO320 
DROGO330 
DROOO346 
DROOG350 
DROOG360 
DROGO370 
DROGO386 
DROGO390 
DROGO400 
DROOO410 
DROGG426 
DROGO4 36 
DROGG440 
DROGO45@ 
DROOO460 
DROGO4 70 
DROGO480 
DROOO490 
DROGO500 
DROOG510 
DROGO526 
DROGO530 
DROOG546 
DROGG55@ 
DROOO560 
DROOO57@ 
DROOG58@ 
DROGOG596 
DROOG60O 
DROGG6106 
DROGG620 
DROGG630 
DROGGO646 
DROGG65¢6 
DROOG660 
DROGG67@ 
DROOG68¢6 
DROGG690 
DROOO700 
DROGO710 
DROGG72¢6 
DROOG736 
DROGO740 
DROOO75¢ 
DROGO760 
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C 


DH11=ZERO 
DH12=ZERO 
DH21=ZERO 
DH22=ZERO 


DD1=ZERO 
DD2=ZERO 
DX1=ZERO 
RETURN. . 
GO TO 226 
PROCEDURE. .FIX-H.. 
7@ CONTINUE 


IF(.NOT. DFLAG .GE. ZERO) GO TO 90 


IF(.NOT. DFLAG .EQ. ZERO) GO TO 8@ 


DH11=ONE 
DH22=ONE 
DFLAG=-ONE 
GO TO 9¢ 
80 CONTINUE 
DH21=-ONE 
DH12=ONE 
DFLAG=-ONE 
90 CONTINUE 
GO TO IGO, (126,15¢,18@, 210) 
PROCEDURE. . SCALE-CHECK 
1¢¢@ CONTINUE 
110 CONTINUE 


IF(.NOT. DD1 .LE. RGAMSQ) GO TO 13¢ 
IF(DD1 .EQ. ZERO) GO TO 16¢ 


ASSIGN 12@ TO IGO 
FIX-H.. 
GO TO 70 

126 CONTINUE 
DD1=DD1*GAM**2 
DX1=DX1/GAM 
DH11=DH11/GAM 
DH12=DH12/GAM 

GO TO 11¢ 
139 CONTINUE 
140 CONTINUE 


IF(.NOT. DD1 .GE. GAMSQ) GO TO 16¢@ 


ASSIGN 15@ TO IGO 
FIX-H.. 
GO TO 70 
150 CONTINUE 
DD1=DD1/GAM**2 
DX1=DX1*GAM 
DH11=DH11*GAM 
DH12=DH12*GAM 
GO TO 14¢ 
160 CONTINUE 
170 CONTINUE 
IF(.NOT. DABS(DD2) .LE. 


RGAMSQ) GO TO 19¢ 


IF(DD2 .EQ. ZERO) GO TO 22¢ 


ASSIGN 18@ TO IGO 
FIX-H.. 
GO TO 7@ 

180 CONTINUE 
DD2=DD2*GAM** 2 
DH21=DH21/GAM 
DH2 2=DH22/GAM 

GO TO 1706 
190 CONTINUE 
2060 CONTINUE 
IF(.NOT. DABS(DD2) .GE. 
ASSIGN. 21¢ TO IGO 
FIX-H.. 
GO TO 7@ 

210 CONTINUE 
DD2=DD2/GAM**2 
DH21=DH21*GAM 
DH22=DH22*GAM 

GO TO 20@ 
220 CONTINUE 
LF (DFLAG) 250, 230, 24@ 


GAMSQ) GO TO 22¢ 


DROGG7 70 
DROGG780 
DROOG79@ 
DROGG8OO 
DROGG810 
DROGG820 
DROGG830 
DROGO840 
DROOGE5O 
DROGO860 
DROOO870 
DROGG88G 
DROGG89G 
DROOGIGDD 
DROGOI10 
DROOOI20 
DROGG9 30 
DROGG940 
DROOG950 
DROGO960 
DROOG9 70 
DROGHI8A 
DROODIIP 
DROG100¢ 
DROO1G16 
DROO1920 
DROG1030 
DROG1040 
DROG1O5@ 
DROO106¢ 
DROG1070 
DROG1080 
DROO1G699 
DROG110¢ 
DRO@111@ 
DRO@1120 
DROG1130 
DRO@114¢ 
DRO@115¢ 
DRO@116¢ 
DROO117¢0 
DROG118¢ 
DROG1190 
DROG1200 
DROO1210 
DROO122¢ 
DROO1230 
DROG1246 
DROO125¢ 
DROO1260 
DROO1270 
DROGO1280 
DROO1290 
DROO1300 
DRO@1310 
DROO1320 
DROG1330 
DROO1340@ 
DROO1350 
DROG1360 
DROO137¢ 
DROO1380 
DRO@1390 
DROO1400 
DROO1410 
DROO1420 
DROG1430 
DRO@1440 
DRO@145@ 
DRO@1466 
DROO1476 
DROG1480 
DROG1490 
DROGO1500 
DROO1510 
DROO1520 
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246 


250 


260 


agaannaananannannananna 


1¢ 


20 
30 


40 
50 


CONTINUE DRO@1530 
DPARAM(3)=DH21 DRO@154@ 
DPARAM(4)=DH12 DROG1550 
GO TO 26@ DROO1560 

CONTINUE DROO1570 
DPARAM(2)=DH11 DROG1580 
DPARAM(5)=DH22 DROO1590 
GO TO 26@ DROG1600 

CONTINUE DROO1610 
DPARAM(2)=DH11 DROO16206 
DPARAM(3)=DH21 DROO1630 
DPARAM(4)=DH12 DROO1L640 
DPARAM(5)=DH22 DROO165@ 

CONTINUE DROO1660 
DPARAM(1)=DFLAG DROO1670 
RETURN DROG168¢ 

END DROO169¢ 

SUBROUTINE SROTM (N,SX,INCX,SY,INCY,SPARAM) SR28430 

SR2844@ 
APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX SR2845@ 
SR28460 

(SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN 

(DX**T) 

SX (LX+L*INCX), I = @ TO N-1, WHERE LX = 1 IF INCX .GE. 6, ELSE 

LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. 

WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. SR28510 

SR28520 

SFLAG=-1.E@ SFLAG=@.E@ SFLAG=1.E@ SFLAG=-2.E@ SR28530 
SR28540 

(SH11 SH12) (1.E@ SH12) (SH11 1.5) (1.E® @.EO) SR28550 
H= ( ) ( ) ) ( ) SR28560 
(SH21 SH22), (SH21 1.E@), (-1.E@ SH22), (@.E@ 1.E@). SR28570 

SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. 

SR28580 

DIMENSION SX(1),SY(1) ,SPARAM(5) SR28590 

DATA ZERO, TWO/@.E@,2.E0/ SR28600 

SR28610 

SFLAG=SPARAM(1) SR28620 

IF(N .LE. @ .OR. (SFLAG+TWO.EQ.ZERO)) GO TO 146 SR28630 
IF(.NOT. (INCX.EQ.INCY.AND. INCX .GT.@)) GO TO 7¢ SR2864@ 

SR28650 

NSTEPS=N*INCX SR28660 
LF(SFLAG) 50,16,3@ SR28670 
CONTINUE SR28680 
SH12=SPARAM(4) SR28690 
SH21=SPARAM (3) SR287060 
DO 20 I=1,NSTEPS,INCX SR28710 
W=SX(L) SR28720 

Z=SY (1) SR28730 

SX (1) =W+Z*SHL2 SR28746 

SY (1)=W*SH21+Z SR2875@ 
CONTINUE SR2876@ 

GO TO 14¢@ SR28770 
CONTINUE SR28780 
SH11=SPARAM(2) SR2879@ 
SH22=SPARAM(5) SR28800 
DO 40 I=1,NSTEPS,INCX SR28810 
W=SX(L) SR28820 

Z=SY (1) SR2883¢ 
SX(1)=W*SH11+Z SR28840 

SY (L)=-W+SH22*Z SR28850 
CONTINUE SR28860 

GO TO 14¢ SR28870 
CONTINUE SR28880 
SH11=SPARAM (2) SR28890 
SH12=SPARAM(4) SR28900 
SH21=SPARAM (3) SR28910 
SH22=SPARAM(5) SR28920 
DO 6@ I=1,NSTEPS, INCX SR28930 
W=SX(L) SR28940 
Z=SY(L) SR2895@ 
SX(1)=W*SH11+Z*SH12 SR28960 
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99 
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120 


130 
140 


SY (1) =W*SH21+Z*SH22 
CONTINUE 
GO TO 149 
CONTINUE 
KxX=1 
KY=1 


IF(INCX .LT. @) KX=1+(1-N)*INCX 
IF(INCY .LT. @) KY=1+(1-N)*INCY 


LF(SFLAG) 126, 80,100 


CONTINUE 

SH12=SPARAM (4) 

SH21=SPARAM(3) 
DO 99 I=1 
W=SX (KX) 


Z=SY (KY) 


yN 


SX (KX) =W+Z*SH12 
SY (KY) =W*SH21+Z 
KX=KX+INCX 
KY=KY+INCY 


CONTINUE 
GO TO 14¢ 
CONTINUE 
SH11=SPARAM(2) 
SH22=SPARAM(5) 


DO 116 I=1,N 


W=SX (KX) 
Z=SY (KY) 


SX (KX) =W*SH114+Z 
SY (KY) =-W+SH22*Z 
KX=KX+1INCX 
KY=KY+INCY 


CONTINUE 
GO TO 14¢ 
CONTINUE 
SH11=SPARAM(2) 
SH12=SPARAM(4) 
SH21=SPARAM(3) 
SH22=SPARAM(5) 


DO 13¢ I=1,N 


W=SX (KX) 
Z=SY (KY) 


SX (KX) =W*SH11+Z*SH12 
SY (KY) =W*SH21+Z*SH22 
KX=KX+INCX 
KY=KY+INCY 


CONTINUE 
CONTINUE 
RETURN 
END 


SUBROUTINE SCOPY(N,SX,INCX,SY,INCY) 


COPY SINGLE PRECISION SX TO SINGLE PRECISION SY. 

FOR I = @ TO N-1, COPY SX(LX+I*INCX) TO SY(LY+I*INCY), 
WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


REAL SX(1),SY(1) 
IF(N.LE.@) RETURN 


IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60 


CONTINUE 


CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS. 


Ix = 1 


ly = 1 

IF (INCX.LT.@) IX 

LF(INCY.LT.@) IY 

pO 1¢@ I = 1,N 
SY(IY) = SX(1IX) 
IX = LX + INCX 


(-N+1) *INCX + 1 
(-N+1)*INCY + 1 


SR28970 
SR28980 
SR28990 
SR29060 
SR29010 
SR29626 
SR29630 
SR29040 
SR29050 
SR29960 
SR29670 
SR290806 
SR29696 
SR29160 
SR291106 


SR29126 
SR2913¢ 
SR29140 
SR2915¢ 
SR29160 
SR2917@ 
SR29186 
SR2919¢6 
SR29200 
SR29210 
SR29220 
SR29230 
SR29240 
SR29250 
SR29266 
SR29270 
SR29286 
SR29290 
SR29300 
SR29316 
SR29326 
SR29 330 
SR29 340 
SR29350 
SR29 3606 
SR29370 
SR29 380 
SR29390 
SR29400 
SR29410 
SR29420 
SR29430 
SR29440 
SR29456 
SR29460 


SC30530 
SC30654@ 
SC30550 


$C30560 
$C30570 
$C30580 
SC306590 
SC30600 
SC30610 
SC30620 
SC30630 
SC30649 


$C30650 
SC30660 
SC3067¢ 
SC3G680 
SC30690 
SC306760 
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IY = LY + INCY 
1@ CONTINUE 


RETURN 
CODE FOR BOTH INCREMENTS EQUAL TO 1 
CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 7. 
2¢ M = MOD(N,7) 
IF( M .EQ. @ ) GO TO 4@ 
DO 36 I = 1,M 
SY(I) = SX(T) 
3@ CONTINUE 
IF( N .LT. 7 ) RETURN 
49 MP1 =M+1 
DO 5@ I = MP1,N,7 
SY(I) = SX(I) 
SY(I + 1) = SX(I + 1) 
SY(I + 2) = SX(I + 2) 
SY(I + 3) = SX(I + 3) 
SY(I + 4) = SX(I + 4) 
SY(I + 5) = SX(I + 5) 
SY(I + 6) = SX(I + 6) 
50 CONTINUE 
RETURN 
CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS. 


60 CONTINUE 
NS = N*INCX 
DO 7@ I=1,NS,INCX 
SY(I) = SX(I) 
70 CONTINUE 
RETURN 
END 


SUBROUTINE DCOPY (N,DX, INCX,DY, INCY) 


COPY DOUBLE PRECISION DX TO DOUBLE PRECISION DY. 

FOR I = @ TO N-1, COPY DX(LX+I*INCX) TO DY(LY+I*INCY), 
WHERE LX = 1 IF INCX .GE. 6, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


DOUBLE PRECISION DX(1) ,DY(1) 


IF (N.LE.@) RETURN 
IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60 
5 CONTINUE 


CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS. 


TX = 1 

Ty=1 

IF (INCX.LT.@) 1X 

IF (CINCY .LT.@) LY 

DO 1¢ LI = 1,N 
DY(IY) = DX(IX) 
Ix = IX + INCX 
Iy = LY + INCY 

1@ CONTINUE 
RETURN 


(-N+1)*INCX + 1 
(-N+1) *INCY + 1 


CODE FOR BOTH INCREMENTS EQUAL TO 1 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 7. 


2@ M = MOD(N,7) 
IF( M .EQ. @ ) GO TO 4¢ 
DO 39 I = 1,M 
DY(I) = DX(I) 
30 CONTINUE 
IF( N .LT. 7 ) RETURN 


SC30710 
SC30726 
C3673 
SC30746 
SC30750 
SC30766 
$C30770 
SC3078¢ 
SC36790 


$C306810 
SC30820 
SC306836 
SC30840 
SC30850 
SC30860 
SC36870 
SC30880 
SC30890 
SC36900 
SC306910 
SC30920 
SC390930 
SC30946 
SC30956 
SC36960 
SC3097¢ 
SC36980 
SC30990 
SC31000 
SC31010 
$C31062¢ 
SC3103¢ 
SC31040 
S$C31050 
SC31060 


DC31076 
DC3108¢@ 
DC3109¢ 


DC3110@ 
DC31110 


DC3112¢ 
DC31130 
DC3114¢ 
DG3115¢ 
DC3116¢ 
DC31170 
DC31180 
DC31196 
DC3120¢0 
DC31210 
DC31220 
DC31230 
DC31240 
DC31250 
DC3126@ 
DC3127¢ 
DC31286 
DC31296 
DC31360 
DC3131¢ 
DC3132¢ 
DC31330 


DC31350@ 
DC3136¢ 
DC3137@ 
DC3138¢ 
DC31390 
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1¢ 
20 


36 


MPl1=M+1 
DO 5@ I = MP1,N,7 
DY(I) = DX(I) 
DY(I + 1) = DX(I + 1) 
DY(I + 2) = DX(I + 2) 
DY(I + 3) = DX(I + 3) 
DY(I + 4) = DX(I + 4) 
DY(I + 5) = DX(I + 5) 
DY(I + 6) = DX(I + 6) 
CONTINUE 
RETURN 
CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS, 
CONTINUE 
NS=N* INCX 
DO 7@ I=1,NS,INCX 
DY(I) = DX(I) 
CONTINUE 
RETURN 
END 


SUBROUTINE CCOPY (N,CX, INCX,CY,INCY) 


COPY COMPLEX CX TO COMPLEX CY. 

FOR I = @ TO N-1, COPY CX(LX+I*INCX) TO CY(LY+I*INCY), 
WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


COMPLEX CX(1),CY(1) 


IF(N .LE. 6) RETURN 

LF (INCX.EQ.INCY.AND.INCX.GT.@) GO TO 2@ 

KX = l 

KY = 1 

IF(INCX.LT.@) KX 

LFC(INCY.LT.@) KY 
DO 1¢@ IT = 1,N 
CY (KY) = CX(KX) 
KX = KX + INCX 
KY = KY + INCY 

CONTINUE 

RETURN 

CONTINUE 

NS = N*INCX 
DO 3@ I=1,NS,INCX 
CY(I) = CX(T) 
CONTINUE 


1+(1-N) *INCX 
1+(1-N) *INCY 


_ RETURN 


END 


SUBROUTINE SSWAP (N,SX,INCX,SY,INCY) 


INTERCHANGE SINGLE PRECISION SX AND SINGLE PRECISION SY. 

FOR I = @ TO N-1, INTERCHANGE SX(LX+I*INCX) AND SY(LY+I1*INCY), 
WHERE LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


REAL SX(1),SY(1) ,STEMP1,STEMP2,STEMP3 
LF (N.LE.@) RETURN 

IF(INCX.EQ.INCY) IF(INCX-1) 5,20,6¢ 
CONTINUE 


CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS. 


IX =1 

Ty =1 

IF (INCX.LT.@) IX 

IF(INCY.LT.@) IY 

DO 16 I = 1,N 
STEMP1 = SX(IX) 


(-N+1)*INCX + 1 
(-N+1)*INCY + 1 


DC3140¢ 
DC31410 
DC3142@ 
DC31430 
DC3144@ 
DC3145¢6 
DC3146@ 
DC3147¢ 
DC3148@ 
DC3149¢0 
DC31500 
DC31510 
DC31526 
DC3153¢ 
DC31540 
DC31550 
DC31560 
DC31576 
DC31580 
DC3159¢ 
DC3166¢ 


CC3161¢@ 


CC31650 
CC31660 
CC31670 
CC3168¢6 
CC3169@ 
CC31700 
CC3171¢ 
CC31720 
CC31730 
CC31740 
CC31750 
CC31760 
CC31770 
CC31786 
CC31790 
CC31800 
CC318190 
CC3182¢ 
CC31830 
CC31840 
CC3185@ 


S$$31866 
S$S3187@ 
SS31880 


$S31890 
$S531900 
$S$31910 
$S31920 
$53193@ 
$831940 
$S$3195@ 
S$$31960@ 
$831976 
$S$31986 
$$31990 
SS 32000 
$S32@10 
SS 32020 
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SX(IX) = SY(IY) 
SY(IY) = STEMP1 
IX = IX + INCX 


TY = IY + INCY 


CONTINUE 
RETURN 


CODE FOR BOTH INCREMENTS EQUAL TO 1 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 3. 


M = MOD(N, 3) 
IF( M .EQ. @ ) GO TO 4@ 
DO 30 I = 1,M 

STEMP1 = SX(I) 

SX(I) = SY(I) 


SY(I) = STEMP1 

CONTINUE 

IF( N .LT. 3 ) RETURN 

MP1 =M+1 

DO 50 I = MP1,N,3 
STEMP1 = SX(I) 
STEMP2 = SX(I+1) 
STEMP3 = SX(I+2) 
SX(I) = SY(TI) 
SX(I+1) = SY(I+1) 
SX(I+2) = SY(I+2) 
SY(I) = STEMP1 
SY(I+1) = STEMP2 
SY(I+2) = STEMP3 

CONTINUE 

RETURN 

CONTINUE 


CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS. 


NS = N*INCX 
DO 7@ I=1,NS,INCX 
STEMP1 = SX(I) 
SX(I) = SY(1) 
SY(I) = STEMP1 
CONTINUE 

RETURN 

END 


SUBROUTINE DSWAP(N,DX, INCX, DY, INCY) 


INTERCHANGE DOUBLE PRECISION DX AND DOUBLE PRECISION DY. 

FOR I = @ TO N-1, INTERCHANGE DX(LX+1*INCX) AND DY (LY+I*INCY), 
WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. 


DOUBLE PRECISION DX(1) ,DY(1) ,DTEMP1,DTEMP2, DTEMP3 


IF(N.LE.@) RETURN 
IF(INCX.EQ.INCY) IF(INCX-1) 5,24,60 
CONTINUE 


CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS. 


Ix = 1 

I¥ = 1 

IF (INCX.LT.6) LX 

IF (INCY.LT.@) LY 

DO 10 I = 1,N 
DTEMP1 = DX(IX) 
DX(IX) = DY(IY) 
DY(IY) = DTEMPL1 
IX = IX + INCX 
IY = LY + INCY 

CONTINUE 

RETURN 


(-N+1)*INCX + 1 
(-N+1)*INCY + 1 


toil 


$8320630 
SS32040 
SS 32050 


SS32060 
$$32070 
5832080 
$S320690 
SS3216@ 
$S32116 
$$ 32126 
$S$32130 
SS32140 


$S32160 
$S$32170 
$S32180 
SS32190 
SS$32260 
$S32210 
SS 32220 
S$ 32230 
$S32240 
SS32250 
SS 32260 
S$ 32276 
SS32280 
$$32290 
SS32300 
§$32310 
$$ 32320 
SS32330 
SS 32340 
$$32356 
SS 32360 
SS 32370 
$S32380 
$832390 
SS32406 
SS32410 
$S$32420 
§53243¢ 
$S832446 
$S832450 
$$32460 
SS32470 


DS 32480 
DS3249¢@ 
DS 32500 


DS32510 
DS 32520 


DS32530 
DS32546 
DS32550@ 
DS3256@ 
DS32570 
DS32580 
DS32590 
DS 32600 
DS3261¢ 
DS3262¢ 
DS 32630 
DS3264¢ 
DS3265¢@ 
DS32660 
DS32670 
DS3268¢ 
DS3269@ 
DS32700 
DS 32710 
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CODE FOR BOTH INCREMENTS EQUAL TO 1 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 3. 


M = MOD(N, 3) 
IF( M .EQ. @ ) GO TO 4@ 
DO 36 I = 1,M 

DTEMP1 = DX(I) 

DX(I) = DY(I) 

DY(I) = DTEMP1 


CONTINUE 

IF( N .LT. 3 ) RETURN 

MP1 =M+1 

DO 5@ I = MP1,N,3 
DTEMP1 = DX(I) 
DTEMP2 = DX(I+1) 
DTEMP3 = DX(I+2) 
DX(I) = DY(I) 
DX(I+1) = DY(I+1) 
DX(I+2) = DY(I+2) 
DY(I) = DTEMP1 
DY(I+1) = DTEMP2 
DY(I+2) = DTEMP3 

CONTINUE 

RETURN 

CONTINUE 


CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS. 


NS = N*INCX 
DO 7¢@ I=1,NS,INCX 
DTEMP1 = DX(1) 


DX(I) = DY(I) 
DY(I) = DTEMP1 
CONTINUE 
RETURN 
END 


SUBROUTINE CSWAP(N,CX, INCX,CY, INCY) 


INTERCHANGE COMPLEX CX AND COMPLEX CY 


FOR I = @ TO N-1, INTERCHANGE CX(LX+I*INCX) AND CY (LY+I*INCY), 
WHERE LX = 1 IF INCX .GT. 6, ELSE LX = (-INCX)*N, AND LY IS 


DEFINED IN A SIMILAR WAY USING INCY. 
COMPLEX CX(1) ,CY(1) ,CTEMP 


LF(N .LE. @)RETURN 

LF (INCX.EQ.INCY.AND.INCX.GT.@) GO TO 20 

KX = 1 

KY = 1 

LF(INCX.LT.@) KX 

IF(INCY.LT.@) KY 
DO 10 I = 1,N 
CTEMP = CX(KX) 
CX(KX) = CY (KY) 
CY (KY) = CTEMP 
KX = KX + INCX 
KY = KY + INCY 

CONTINUE 

RETURN 

CONTINUE 

NS = N*INCX 
DO 3@ I=1,NS,INCX 
CTEMP = CX(I1) 
CX(I) = CY(I) 
CY(1) = CTEMP 
CONTINUE 

RETURN 

END 


1+(1-N) *INCX 
1+(1-N) *INCY 


DS32720 
DS3273@ 
DS3274@ 
DS3275@ 
DS3276@ 


DS3278@ 
DS3279@ 
DS328060 
DS 32816 
DS32820 
DS32830 
DS 32840 
DS32856 
DS 32860 
DS32870 
DS 32880 
DS3289¢ 
DS 32960 
DS3291¢ 
DS 32920 
DS3293¢ 
DS32940 
DS32950 
DS 32960 
DS 3297 
DS 32980 
DS 32996 
DS33000 
DS3301¢ 
DS 33620 
DS 33036 
DS33046 
DS33056 
DS33060 
DS33070 
DS 330680 
DS 33090 


CS33160 


CS3314@ 
CS3315¢ 
CS33160 
CS33170 
CS33186 
CS3319@ 
CS332060 
CS33210 
CS 33220 
CS33230 
CS33246 
CS33250 
CS3326¢ 
CS33270 
CS33280 
CS33296 
CS3330¢ 
CS33310 
CS33320 
CS33330 
CS 33340 
CS33350 
CS33360 
CS3337@ 
CS33380 
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COLLECTED ALGORITHMS (cont.) 539-P21- 0 


REAL FUNCTION SNRM2 ( N, SX, INCX) 

INTEGER NEXT 

REAL SX(1), CUTLO, CUTHI, HITEST, SUM, XMAX, ZERO, ONE 
DATA ZERO, ONE /@.@E@, 1.0620/ 


EUCLIDEAN NORM OF THE N-VECTOR STORED IN SX() WITH STORAGE 
INCREMENT INCX . 

IF N .LE. @ RETURN WITH RESULT = @. 

IF N .GE. 1 THEN INCX MUST BE .GE. 1 


AAAAARAANDA 


C.L.LAWSON, 1978 JAN $8 


FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE 
HOPEFULLY APPLICABLE TO ALL MACHINES. 
CUTLO = MAXIMUM OF SQRT(U/EPS) OVER ALL KNOWN MACHINES. 
CUTHI = MINIMUM OF SQRT(V) OVER ALL KNOWN MACHINES. 
WHERE 
EPS 
U 
Vv 


SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. 
SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) 
LARGEST NO, (OVERFLOW LIMIT) 


BRIEF OUTLINE OF ALGORITHM.. 


PHASE 1 SCANS ZERO COMPONENTS. 

MOVE TO PHASE 2 WHEN A COMPONENT IS NUNZEKO AND .LE, CULLU 
MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO 

MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M 

WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. 


VALUES FOR CUTLO AND CUTHI.. 
FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER 
DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. 
CUTLO, S.P. U/EPS = 2**(-162) FOR HONEYWELL. CLOSE SECONDS ARE 
UNIVAC AND DEC AT 2**(-163) 
THUS CUTLO = 2**(-51) = 4.44@89E-16 
CUTHI, S.P.  V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. 
THUS CUTHI = 2%*(63.5) = 1.30438E19 
CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. 
THUS CUTLO = 2**(-33.5) = 8.23181D-11 
CUTHI, D.P. SAME AS S.P. CUTHI = 1.306438D19 
DATA CUTLO, CUTHI / 8.232D-11, 1.3@4D19 / 
DATA CUTLO, CUTHI / 4.441E-16, 1.3@4E19 / 
DATA CUTLO, CUTHI / 4.441E-16, 1.304519 / 


QAAAMQAQANAAAAMNAMNANANAAANAANDANANAEAAMAANAANAAAAAAAAANA 


Cc 
IF(N .GT. 6) GO TO 16 
SNRM2 = ZERO 
GO TO 300 
6 
1@ ASSIGN 3@ TO NEXT 
SUM = ZERO 
NN = N * INCX 
¢ BEGIN MAIN LOOP 
i= 1 
20 GO TO NEXT, (36, 56, 7@, 110) 
3@ IF( ABS(SX(L)) .GT. CUTLO) GO TO 85 
ASSIGN 5@ TO NEXT 
XMAX = ZERO 
Cc 
Cc PHASE 1. SUM IS ZERO 
Cc 


5@ IF( SX(I) .EQ. ZERO) GO TO 2@¢ 
DNRM2 = XMAX * DSQRT(SUM) 

36% CONTINUE 
RETURN 
END 


REAL FUNCTION SCNRM2( N, CX, INCX) 
LOGICAL IMAG, SCALE 


INTEGER NEXT 

REAL CUTLO, CUTHI, HITEST, SUM, XMAX, ABSX, ZERO, ONE 
COMPLEX CX(1) 

DATA ZERO, ONE /@.0EO, 1.GE@/ 


e 


COLLECTED ALGORITHMS (cont.) 539-P22- 0 


UNITARY NORM OF THE COMPLEX N-VECTOR STORED IN CX() WITH STORAGE 
INCREMENT INCX . 

IF N .LE. @ RETURN WITH RESULT = @. 

IF N .GE. 1 THEN INCX MUST BE .GE. 1 


C.L.LAWSON , 1978 JAN $8 


FOUR PHASE METHOD USING TWO BUILT-IN CONSTAN’S THAT ARE 
HOPEFULLY APPLICABLE TO ALL MACHINES, 
CUTLO = MAXIMUM OF SQRT(U/EPS) OVER ALL KNOWN MACHINES. 
CUTHI = MINIMUM OF SQRT(V) OVER ALL KNOWN MACHINES. 
WHERE 
EPS SMALLEST NO. SUCH THAT EPS + 1. .GT. l. 
U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) 
Vv = LARGEST NO. (OVERFLOW LIMIT) 


BRIEF OUTLINE OF ALGORITHM.. 


PHASE 1 SCANS ZERO COMPONENTS. 

MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO 
MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO 

MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M 

WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. 


VALUES FOR CUTLO AND CUTHI.. 
FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER 
DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. 
CUTLO, S.P.  U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE 
UNIVAC AND DEC AT 2**(-1@3) 
THUS CUTLO = 2**(-51) = 4.44Q@89E-15 
CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. 
THUS CUTHI = 2**(63.5) = 1.30438E19 
CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. 
THUS CUTLO = 2**(-33.5) = 8.23181D-11 
CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D19 
DATA CUTLO, CUTHI / 8.232D-11, 1.3@4D19 / 
DATA CUTLO, CUTHI / 4.441E-16, 1.3064E19 / 
DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / 


MTAAAAAQAARANAAAAAAAANAAARAAAAARARAAARAAAARAAAAARAAARAA 


C 
IF(N .GT. 6) GO TO 1¢@ 
SCNRM2 = ZERO 
GO TO 30@ 
C 
1@ ASSIGN 36 TO NEXT 
SUM = ZERO 
NN = N * INCX 
C BEGIN MAIN LOOP 
DO 21@ I=1,NN, INCX 
ABSX = ABS(REAL(CX(I))) 
IMAG = .FALSE. 
GO TO NEXT, (36, 50, 70, 96, 11) 
36 IF( ABSX .GT. CUTLO) GO TO 85 
ASSIGN 5@ TO NEXT 
SCALE = .FALSE. 
C 
Cc PHASE 1. SUM IS ZERO 
C 
5@ IF( ABSX .EQ. ZERO) GO TO 26¢ 
IF( ABSX .GT. CUTLO) GO TO 85 
Cc 
Cc PREPARE FOR PHASE 2. 
ASSIGN 7@ TO NEXT 
GO TO 1065 
C 
Cc PREPARE FOR PHASE 4. 
Cc 
16@ ASSIGN 110 TO NEXT 
SUM = (SUM / ABSX) / ABSX 
105 SCALE = .TRUE. 
XMAX = ABSX 
GO TO 115 
6 
Cc PHASE 2. SUM IS SMALL. 
Cc SCALE TO AVOID DESTRUCTIVE UNDERFLOW. 
C 


7@ IF( ABSX .GT. CUTLO ) GO TO 75 


COLLECTED ALGORITHMS (cont.) 


Aaa 


aaand 


aAaAAN 


Aaa 


agaaaaana 


COMMON CODE FOR PHASES 2 AND 4. 


IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. 


11@ IF( ABSX .LE. XMAX ) GO TO 115 


115 


75 


85 


99 
200 


21¢ 


210 


300 


10 


SUM = ONE + SUM * (XMAX / ABSX)**2 
XMAX = ABSX 
GO TO 2¢¢@ 
SUM = SUM + (ABSX/XMAX)**2 
GO TO 20¢ 
PREPARE FOR PHASE 3. 
SUM = (SUM * XMAX) * XMAX 


ASSIGN 9@ TO NEXT 
SCALE = .FALSE. 


CUTHI/N 
CUTHI/ (2*N) 


FOR REAL OR D.P. SET HITEST 
FOR COMPLEX SET HITEST 


HITEST = CUTHI/FLOAT( N ) 
PHASE 3. SUM IS MID-RANGE. NO SCALING. 


IF(ABSX .GE. HITEST) GO TO 10 
SUM = SUM + ABSX**2 
CONTINUE 
CONTROL SELECTION OF REAL AND IMAGINARY PARTS. 


IF (IMAG) GO TO 2164 
ABSX = ABS(AIMAG(CX(I))) 
IMAG = .TRUE. 

GO TO NEXT,( 54, 76, 90, 110 ) 


CONTINUE 
IMAG = .TRUE. 
GO TO NEXT,( 5@, 76, 96, 11@ ) 


CONTINUE 


END OF MAIN LOOP. 
COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. 


SCNRM2 = SQRT(SUM) 

IF(SCALE) SCNRM2 = SCNRM2 * XMAX 
CONTINUE 

RETURN 

END 


REAL FUNCTION SASUM(N, SX, INCX) 


RETURNS SUM OF MAGNITUDES OF SINGLE PRECISION SX. 
SASUM = SUM FROM @ TO N-1 OF ABS(SX(1+I*INCX) ) 


REAL SX(1) 

SASUM = @. GEG 

IF (N.LE.@) RETURN 

IF (INCX.EQ.1)GOTO 2¢ 


CODE FOR INCREMENTS NOT EQUAL TO 1. 
NS = N*¥INCX 
DO 1@ I=1,NS,INCX 
SASUM = SASUM + ABS(SX(I)) 
CONTINUE 
RETURN 


CODE FOR INCREMENTS EQUAL TO 1. 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 6. 


SA35810 
SA35820 
SA3583@ 


SA35840 
SA35850 
SA35860 
SA35870 
SA35 880 
SA35890 
SA3590@ 
SA35910 
SA35920 
SA3593¢ 
SA3594@ 
SA35950 
SA35960 
SA3597@0 
SA3598¢ 
SA35990 
SA36000 
SA36010 
SA 36020 
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COLLECTED ALGORITHMS (cont.) 


aqaaan 


is) 


AaAaaaan 


AaAaAAn 


(2) 


Aaa 


2¢ M = MOD(N, 6) 
IF( M .EQ. 6 ) GO TO 4@ 
DO 3@ I = 1,M 
SASUM = SASUM + ABS(SX(I)) 
3@ CONTINUE 
IF( N .LT. 6 ) RETURN 


DO 5@ I = MP1,N,6 
SASUM = SASUM + ABS(SX(L)) + ABS(SX(I + 1)) + ABS(SX(I + 2)) 
$ + ABS(SX(I + 3)) + ABS(SX(I + 4)) + ABS(SX(I + 5)) 
5@ CONTINUE 
RETURN 
END 


DOUBLE PRECISION FUNCTION DASUM(N, DX, INCX) 


RETURNS SUM OF MAGNITUDES OF DOUBLE PRECISION DX. 
DASUM = SUM FROM @ TO N-1 OF DABS(DX(1+I*INCX)) 


DOUBLE PRECISION DX(1) 
DASUM = @.D@ 

IF (N.LE.@) RETURN 

IF (INCX.EQ.1)GOTO 2 


CODE FOR INCREMENTS NOT EQUAL TO 1. 


NS = N*INCX 
DO 1@ I=1,NS, INCX 
DASUM = DASUM + DABS (DX(I)) 
1¢ CONTINUE 
RETURN 


CODE FOR INCREMENTS EQUAL TO 1. 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 6. 


2@ M = MOD(N, 6) 
IF( M .EQ. @ ) GO TO 46 
DO 36 I = 1,M 
DASUM = DASUM + DABS(DX(1)) 
39 CONTINUE 
IF( N .LT. 6 ) RETURN 
4@ MP1 =Mt1 
DO 5@ I = MP1,N,6 
DASUM = DASUM + DABS(DX(1)) + DABS(DX(I+1)) + DABS (DX(I+2)) 
S$ + DABS(DX(I+3)) + DABS(DX(1+4)) + DABS (DX(I+5) ) 
5@ CONTINUE 
RETURN 
END 


FUNCTION SCASUM(N, CX, INCX) 
RETURNS SUMS OF MAGNITUDES OF REAL AND IMAGINARY PARTS OF 
COMPONENTS OF CX. NOTE THAT THIS IS NOT THE L1 NORM OF CX. 
CASUM = SUM FROM @ TO N-1 OF ABS (REAL(CX(1+I*INCX))) + 

ABS (IMAG (CX (1+ I* INCX) ) ) 


COMPLEX CX(1) 


SCASUM=0. 
IF(N .LE. 6) RETURN 
NS = N*INCX 
DO 1@ I=1,NS, INCX 
SCASUM = SCASUM + ABS(REAL(CX(1))) + ABS (AIMAG(CX(I))) 
10 CONTINUE 
RETURN 
END 


SUBROUTINE SSCAL(N, SA, SX, INCX) 


REPLACE SINGLE PRECISION SX BY SINGLE PRECISION SA*SX., 
FOR I = @ TO N-1, REPLACE SX(1+I*INCX) WITH SA * SX(1+I*INCX) 


SA366406 
SA36050 
SA36066 
SA360670 
SA36680 
SA36090 
SA361060 
SA36116 
SA3612¢ 
$A3613¢ 
SA36146 
SA36150 


DA36160 
DA3617@ 
DA3618¢ 


DA36196 
DA36200 
DA36216 
DA36226 
DA 36230 
DA3624 


DA3625¢ 
DA36260 
DA3627@ 
DA36280 
DA36299 
DA36 300 
DA36310 
DA3632@ 
DA36330 
DA3634@ 
DA36350 
DA36360 
DA36370 


DA3639¢@ 
DA364060 
DA36410 
DA3642@ 
DA36430 
DA3644@ 
DA36456 
DA3646@ 
DA36470 
DA36480 
DA3649¢@ 
DA36500 


S$C3651¢ 


SC36560 
SC36570 
SC 3658¢@ 
$C3659¢ 
SC36660 
$C 366106 
SC36620 
SC36630 
SC36640 
SC3665¢ 


SS 36660 
SS36670@ 
SS36680 
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COLLECTED ALGORITHMS (cont.) 


C 


aang 


aqaaAaaAaaaAna 


aaAaana 


aan 


aAaAaAaaAaAn 


REAL SA, SX (1) 
IF (N.LE.@) RETURN 
IF (INCX.EQ.1)GOTO 2¢ 


CODE FOR INCREMENTS NOT EQUAL TO 1. 


NS = N*¥INCX 
DO 1@ I = 1,NS,INCX 
SX(I) = SA*SX(I) 
1¢ CONTINUE 
RETURN 


CODE FOR INCREMENTS EQUAL TO 1. 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5. 


2@ M = MOD(N, 5) 
IF( M .EQ. @ ) GO TO 4@ 
DO 36 I= 1M 
SX(I) = SA*SX(I) 
3@ CONTINUE 
IF( N .LT. 5 ) RETURN 
4@ MPl1=M+1 


DO 5@ I = MP1,N,5 
SX(I) = SA*SX(1) 
SX(I + 1) = SA*SX(I + 1) 
SX(I + 2) = SA*SX(I + 2) 
SX(I + 3) = SA*SX(I + 3) 
SX(I + 4) = SA*SX(I + 4) 

5@ CONTINUE 
RETURN 
END 


SUBROUTINE DSCAL(N,DA, DX, INCX) 


REPLACE DOUBLE PRECISION DX BY DOUBLE PRECISION DA*DX. 
FOR I = @ TO N-1, REPLACE DX(1+I*INCX) WITH DA * DX(1+I*INCX) 


DOUBLE PRECISION DA,DX(1) 
IF (N.LE.@) RETURN 
IF (INCX.EQ.1)GOTO 26 


CODE FOR INCREMENTS NOT EQUAL TO 1. 


NS = N*¥INCX 
DO 1@ I = 1,NS, INCX 
DX(I) = DA*DX(1) 
1¢ CONTINUE 
RETURN 


CODE FOR INCREMENTS EQUAL TO 1. 


CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5. 


2@ M = MOD(N,5) 
IF( M .EQ. @ ) GO TO 4@¢ 
DO 36 I = 1,M 
DX(I) = DA*DX(I) 
3@ CONTINUE 
IF( N .LT. 5 ) RETURN 
49 MPL =M+1 


DO 5@ I = MP1,N,5 
DX(I) = DA*DX(I) 
DX(I + 1) = DA*DX(I + 1) 
DX(I + 2) = DA*DX(I + 2) 
DX(I + 3) = DA*DX(I + 3) 
DX(I + 4) = DA*DX(I + 4) 

5@ CONTINUE 
RETURN 
END 


SS 36696 
SS3670@ 
SS836710 
SS 36720 
$83673¢ 
SS36740 
SS836750 
SS36760 
$S3677¢ 
SS3678@ 
SS 36790 
SS368060 
SS36810 
SS 36820 
$S836830 
SS 36840 
SS3685¢ 
SS 36860 


SS36880 
SS36890 
SS369060 
SS36910@ 
SS 36920 
SS 36930 
SS36946 
$S36950@ 
$S3696¢ 
SS36970 
SS 36980 
SS 36990 
SS37000 
SS3701@ 
SS37626 


DS 37630 
DS3704@ 
DS3705@ 


DS 370660 
DS3767@ 
DS 37680 
DS37¢9@ 
DS37160 
DS37110@ 
DS3712¢@ 
DS3713@ 
DS3714@ 
DS3715¢@ 
DS3716@ 
DS37170 
DS37180 
DS3719@ 
DS 372060 
DS37210 
DS3722@ 
DS3723@ 


DS37250@ 
DS3726@ 
DS3727@ 
DS3728¢@ 
DS3729¢ 
DS373060 
DS3731¢ 
DS3732¢@ 
DS 37330 
DS3734@ 
DS3735¢ 
DS37366 
DS37376@ 
DS37380@ 
DS3739¢@ 
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COLLECTED ALGORITHMS (cont.) 
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Q 
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10 


1¢ 


30 


SUBROUTINE CSCAL(N,CA, CX, INCX) 


REPLACE COMPLEX CX BY COMPLEX CA*CX. 
FOR I = @ TO N-1, REPLACE CX(1+I*INCX) WITH CA * CX(1+1*INCX) 


COMPLEX CA,CX(1) 


IF(N .LE. @) RETURN 

NS = N*INCX 
DO 1@ I = 1,NS, INCX 
CX(I) = CA*CX(I) 
CONTINUE 

RETURN 

END 


SUBROUTINE CSSCAL(N, SA,CX, INCX) 


REPLACE COMPLEX CX BY (SINGLE PRECISION SA) * (COMPLEX CX) 
FOR I = @ TO N-1, REPLACE CX(1+I*INCX) WITH SA * CX(1+I*INCX) 


COMPLEX CX(1) 
REAL SA 


IF(N .LE. 6) RETURN 


NS = N*INCX 
DO 1@ I = 1,NS,INCX 
CX(L) = SA*CX(I) 
CONTINUE 

RETURN 

END 


INTEGER FUNCTION ISAMAX(N,SX, INCX) 


FIND SMALLEST INDEX OF MAXIMUM MAGNITUDE OF SINGLE PRECISION SX. 
ISAMAX = FIRST I, I = 1 TO N, TO MINIMIZE ABS(SX(1-INCX+I*INCX) ) 


REAL SX(1),SMAX, XMAG 


ISAMAX = @ 
IF(N.LE.@) RETURN 
ISAMAX = 1 


IF (N.LE.1)RETURN 
IF (INCX.EQ.1)GOTO 20 


CODE FOR INCREMENTS NOT EQUAL TO 1. 


SMAX = ABS(SX(1)) 

NS = N*INCX 

Il =1 
DO 1@ I=1,NS, INCX 
XMAG = ABS(SX(I)) 
IF (XMAG.LE.SMAX) GO TO 5 
ISAMAX = II 
SMAX = XMAG 
II=IlL+1l 
CONTINUE 

RETURN 


CODE FOR INCREMENTS EQUAL TO 1. 


SMAX = ABS(SX(1)) 
DO 3@ I = 2,N 
XMAG = ABS(SX(I)) 
IF (XMAG.LE.SMAX) GO TO 3¢@ 


ISAMAX = I 

SMAX = XMAG 
CONT INUE 
RETURN 


END 


CS37400 


CS3744@ 
CS37450 
CS37460 
CS37470 
CS 37480 
CS37496 
CS37500 
CS37510 
CS37520 


CS37530 


CS37570 
CS37580 
CS37596 
CS37600 


CS3761¢ 
CS37620 
CS3763@ 
CS37640 
CS37656 
CS376606 


1S3767@ 
183768 
IS37690 


1S3776@ 
IS37716 
1837720 
1837730 
1837740 
1837750 
I1S37760 
1837770 
IS37780 
1837790 
I1S378060 
183781¢ 
183782 
1837830 
1837840 
1837856 
1S3786@ 
183787 
1S 37886 
1S37890 
1S3790¢ 
1837910 
1837920 
1S 37930 
IS3794@ 
1837950 
IS37960 
1837970 
1S 37986 
I8S3799@ 
IS 38000 
1838910 
1S 38020 
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INTEGER FUNCTION IDAMAX(N,DX,INCX) 


FIND SMALLEST INDEX OF MAXIMUM MAGNITUDE OF DOUBLE PRECISION Dx. 
IDAMAX = FIRST I, I = 1 TON, TO MINIMIZE ABS(DX(1-INCX+I*INCX)) 


DOUBLE PRECISION DX(1),DMAX, XMAG 


IDAMAX = @ 
IF(N.LE.@) RETURN 
IDAMAX = 1 


LF (N.LE.1)RETURN 
IF (INCX.EQ.1)GOTO 20 


CODE FOR INCREMENTS NOT EQUAL TO 1. 


DMAX = DABS(DX(1)) 

NS = N*INCX 

Il =1 
DO 19 I = 1,NS,INCX 
XMAG = DABS(DX(I)) 
IF (XMAG.LE.DMAX) GO TO 5 


IDAMAX = IT 
DMAX = XMAG 
5 II = {TI+1 
16 CONTINUE 
RETURN 


CODE FOR INCREMENTS EQUAL TO 1. 


2@ DMAX = DABS(DX(1)) 
DO 3@ I = 2,N 
XMAG = DABS(DX(I)) 
IF (XMAG.LE.DMAX) GO TO 30 


IDAMAX = [ 
DMAX = XMAG 
3@ CONTINUE 
RETURN 


END 


INTEGER FUNCTION ICAMAX(N,CX, INCX) 


RETURNS THE INDEX OF THE COMPONENT OF CX HAVING THE 
LARGEST SUM OF MAGNITUDES OF REAL AND IMAGINARY PARTS. 
ICAMAX = FIRST I, I = 1 TO N, TO MINIMIZE 
ABS (REAL (CX (1- INCX+I*INCX))) + ABS (IMAG (CX (1-INCX+I*INCX) )) 


COMPLEX CX(1) 


ICAMAX = @ 

IF(N.LE.@) RETURN 

ICAMAX = 1 

IF(N .LE. 1) RETURN 

NS = N*INCX 

II =1 

SUMMAX = ABS(REAL(CX(1))) + ABS (AIMAG(CX(1))) 
DO 20 I=1,NS, INCX 
SUMRI = ABS(REAL(CX(I))) + ABS (AIMAG(CX(I))) 
IF (SUMMAX.GE.SUMRI) GO TO 1¢ 
SUMMAX = SUMRI 


10 II = Il +1 
20 CONTINUE 
RETURN 
END 
BEGIN MAIN LOOP 
IT=1 


20 GO TO NEXT, (30, 50, 70, 110) 

3@ IF( DABS(DX(I)) .GT. CUTLO) GO TO 85 
ASSIGN 5@ TO NEXT 
XMAX = ZERO 


PHASE 1. SUM IS ZERO 


5@ IF( DX(L) .EQ. ZERO) GO TO 2¢¢ 
IF( DABS(DX(I)) .GT. CUTLO) GO TO 85 


1D38030@ 
ID3864¢ 
ID3805@ 


ID3806¢ 
ID38070 
1D38068¢@ 
ID3809¢ 
ID38106¢ 
ID3811¢ 
ID38120 
1D38130 
ID3814@ 
ID38150@ 
ID38160 
ID38170 
ID3818¢ 
ID3819¢ 
ID3820¢ 
ID38210 
ID38220 
ID3823@ 
ID38240 
ID3825@ 
ID38260 
ID3827@ 
ID3828¢ 
ID38290 
ID3830@ 
ID3831¢ 
1D38320 
ID3833@ 
1D3834@ 
ID3835@ 
ID3836@ 
ID3837@ 
ID3838¢ 


1038390 


1C3841¢ 
1038420 


1C38440 
IC3845¢@ 
103846 
I1C3847@ 
IC 3848¢ 
1C38496 
1038506 
I1C3851¢ 
IC 38520 
1C3853@ 
1038540 
103855 
1038560 
103857 
1C38580 
1038596 
1C3866¢ 
103861 
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COLLECTED ALGORITHMS (cont.) 530-P28- 0 


Cc 

C PREPARE FOR PHASE 2. 
ASSIGN 7@¢ TO NEXT 
GO TO 145 

C 

Cc PREPARE FOR PHASE 4. 

Cc 

199 T= J 


ASSIGN 116 TO NEXT 

SUM = (SUM / DX(1)) / DX(1) 
105 XMAX = DABS(DX(I)) 

GO TO 115 


Cc 

C PHASE 2. SUM IS SMALL. 

C SCALE TO AVOID DESTRUCTIVE UNDERFLOW. 
C 


7@ IF( DABS(DX(I)) .GT. CUTLO ) GO TO 75 


C 

C COMMON CODE FOR PHASES 2 AND 4, 

C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. 
C 


110 IF( DABS(DX(I)) .LE. XMAX ) GO TO 115 
SUM = ONE + SUM * (XMAX / DX(I))**2 
XMAX = DABS (DX(I)) 
GO TO 20¢ 


115 SUM = SUM + (DX(1)/XMAX)**2 
GO TO 26¢ 


PREPARE FOR PHASE 3. 


OF Coty 


75 SUM = (SUM * XMAX) * XMAX 


FOR REAL OR D.P. SET HITEST 
FOR COMPLEX SET HITEST 


CUTHI/N 
CUTHI/ (2*N) 


AAA 


85 HITEST = CUTHI/FLOAT( N ) 


PHASE 3. SUM IS MID-RANGE. NO SCALING. 


aang 


DO 95 J =I,NN, INCX 

IF(DABS(DX(J)) .GE. HITEST) GO TO 160 
95 SUM = SUM + DX(J)**2 

DNRM2 = DSQRT( SUM ) 

GO TO 30¢ 


200 CONTINUE 
I= I + INCX 
IF ( I .LE. NN ) GO TO 20 


END OF MAIN LOOP. 


COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. 


OOO OG 


I = I + INCX 
IF ( I .LE. NN ) GO TO 26 


END OF MAIN LOOP, 


COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. 


0 Cr oea 


SNRM2 = XMAX * SQRT(SUM) 
360 CONTINUE 

RETURN 

END 


DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX) 

INTEGER NEXT 

DOUBLE PRECISION DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE 
DATA ZERO, ONE /@.@D@, 1.0D@/ 


Cc EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE 
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QR 
No 


10 


60 


INCREMENT INCX . 
IF N .LE. @ RETURN WITH RESULT = @. 
IF N .GE. 1 THEN INCX MUST BE .GE. 1 


C.L.LAWSON, 1978 JAN 68 
FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE 


HOPEFULLY APPLICABLE TO ALL MACHINES. 
CUTLO = MAXIMUM OF DSQRT(U/EPS) OVER ALL KNOWN MACHINES. 


CUTHI = MINIMUM OF DSQRT(V) OVER ALL KNOWN MACHINES. 
WHERE 

EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. 

U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) 

Vv = LARGEST NO. (OVERFLOW LIMIT) 


BRIEF OUTLINE OF ALGORITHM.. 


PHASE 1 SCANS ZERO COMPONENTS. 

MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO 
MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO 

MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M 

WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. 


VALUES FOR CUTLO AND CUTHI.. 
FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER 
DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. 
CUTLO, S.P.  U/EPS = 2**(-=102) FOR HONEYWELL. CLOSE SECONDS ARE 
UNIVAC AND DEC AT 2**(-163) 
THUS CUTLO = 2**(-51) = 4.44689E-16 
CUTHI, S.P.  V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. 
THUS CUTHI = 2** (63.5) = 1.30438E19 
CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. 
THUS CUTLO = 2**(-33.5) = 8. 23181D-11 


CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D19 
DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 / 
DATA CUTLO, CUTHI / 4.441E-16, 1.3@4E19 / 
DATA CUTLO, CUTHI / 8.232D-11, 1.3@4D19 / 


IF(N .GT. 6) GO TO 10 
DNRM2 = ZERO 
GO TO 30¢ 


ASSIGN 3@ TO NEXT 
SUM = ZERO 
NN = N * INCX 


DOUBLE PRECISION FUNCTION DQDOTI(N,DB, QC,DX, INCX,DY, INCY) 
D.P. DOT PRODUCT WITH EXTENDED PRECISION ACCUMULATION (AND RESULT) 
Qc AND DQDOTI ARE SET = DB + SUM FOR I = @ TO N-1 OF 
DX (LX+I*INCX) * DY (LY+I*INCY), WHERE QC IS AN EXTENDED 
PRECISION RESULT WHICH CAN BE USED AS INPUT TO PQDOTA, 
AND LX = 1 IF INCX .GE. @, ELSE LX = (-INCX)*N, AND LY IS 
DEFINED IN A SIMILAR WAY USING INCY. THE MP PACKAGE BY 
RICHARD P. BRENT IS USED FOR THE EXTENDED PRECISION ARITHMETIC, 


FRED T. KROGH, JPL, 1977, JUNE 1 


DOUBLE PRECISION DX(1), DY(1), DB 

INTEGER QC(16), QX(10), QY(10) 

THE COMMON BLOCK FOR THE MP PACKAGE (MODIFIED TO GIVE IT A NAME) 
COMMON /MPCOM/ MPB, MPT, MPM, MPLUN, MPMXR, MPR(12) 

DATA I1/@/ 

IF I1 IS @ THE MP PACKAGE MUST BE INITIALIZED (MPBLAS SETS I1 = 1) 
IF (Il .EQ. 6) CALL MPBLAS(I1) 

Qc(1l) = @ 

IF (DB .EQ. @.D@) GO TO 6¢ 

CALL MPCDM(DB, QX) 

CALL MPADD(QC, QX, QC) 

IF (N .EQ. 6) GO TO 8¢ 


IxX=1 
Ty = 1 
IF (INCX .LT. 6) IX = (-N +1) * INCK +1 
IF (INCY .LT. @) IY = (-N+ 1) * INCY + 1 


po 7@ L#4I1,N 
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CALL MPCDM(DX(IX), QX) 
CALL MPCDM(DY (IY), QY) 
CALL MPMUL(QX, QY, QX) 
CALL MPADD(QC, QX, QC) 
IX = IX + INCX 
IY = IY + INCY 
CONTINUE 
CALL MPCMD(QC, DQDOTI) 
RETURN 
END 


SUBROUTINE DROTM (N,DX, INCX, DY, INCY,DPARAM) 


APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX 


(DX**T) , WHERE **T INDICATES TRANSPOSE, THE ELEMENTS OF DX ARE IN 


(DY*4T) 


DX (LX+I¥INCX), IL = @ TO N-1, WHERE LX = 1 IF INCX .GE. @, ELSE 

LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. 

WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. 

DFLAG=-1. D@ DFLAG=@. D@ DFLAG=1.D¢ DFLAG=-2.D@ 
(DH11 DH12) (1.D@ DH12) (DH11 1.D0) (1.D@ @.DO) 

H= ( ) ( ) ( ) ( ) 
(DH21 DH22), (DH21 1.D@), (-1.D@ DH22), 

SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. 


DOUBLE PRECISION DFLAG, DH12, DH22, DX, TWO, Z,DH11, DH21, 
1 DPARAM, DY ,W, ZERO 

DIMENSION DX(1),DY (1), DPARAM(5) 

DATA ZERO, TWO/@. DO, 2.D0/ 


DFLAG=DPARAM (1) 
IF(N .LE. @ .OR. (DFLAG+TWO.EQ.ZERO)) GO TO 149 
IF(.NOT. (INCX.EQ.INCY.AND. INCX .GT.¢)) GO TO 76 


NSTEPS=N* INCX 
IF (DFLAG) 59,10, 3¢ 
CONTINUE 
DH12=DPARAM (4) 
DH21=DPARAM (3) 
DO 20 I=1,NSTEPS, INCX 
W=DX (I) 
Z=DY (1) 
DX (1)=W+Z*DH12 
DY (L)=W*DH21+Z 
CONTINUE 
GO TO 14¢ 
CONTINUE 
DH11=DPARAM (2) 
DH22=DPARAM (5) 
DO 4@ I=1, NSTEPS, INCX 
W=DX (I) 
Z=DY (I) 
DX (IL)=W*DH11+Z 
DY (1) =-W+DH22*Z 
CONTINUE 
GO TO 140 
CONTINUE 
DH11=DPARAM (2) 
DH12=DPARAM (4) 
DH21=DPARAM (3) 
DH22=DPARAM (5) 
DO 6@ I=1,NSTEPS, INCX 
W=DX (1) 
Z=DY (1) 
DX (L)=W*DH11+Z*DH12 
DY (L)=W*DH21+Z*DH22 
CONTINUE 
GO TO 14¢ 
CONTINUE 
KX=1 


(@.Dd 1.D). 


DR2947@ 
DR2948¢@ 
DR2949¢ 
DR29500 


DR2955@ 
DR2956@ 
DR29570 
DR29589 
DR2959@ 
DR29600 
DR29610 


DR2962@ 
DR2963@ 
DR2964@ 
DR2965@ 
DR29660 
DR29670 
DR2968¢ 
DR2969@ 
DR29760 
DR297190 
DR2972@ 
DR2973@ 
DR29746 
DR2975@ 
DR2976@ 
DR29770 
DR29780 
DR2979@ 
DR29 800 
DR2981¢ 
DR2982@ 
DR29830 
DR2984@ 
DR2985¢@ 
DR2986¢ 
DR2987@ 
DR2988@ 
DR2989¢ 
DR299900 
DR2991¢ 
DR29920 
DR29930 
DR29940 
DR29956 
DR2996@ 
DR2997@ 
DR29980 
DR2999@ 
DR30000 
DR30616 
DR30020 
DR3003¢ 
DR3G040 
DR30050 
DR30GO60 
DR30070 
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KY=1 DR30080 
IF(INCX .LT. @) KX=1+(1-N) *INCX DR36990 
IF(INCY .LT. @) KY=1+(1-N) *INCY DR30100 

Cc DR30116 
IF (DFLAG) 12@, 80, 16@ DR3012¢6 

80 CONTINUE DR30130 
-DH12=DPARAM (4) DR3014@ 
DH21=DPARAM (3) DR3015@ 

DO 96 I=1,N DR306160 

W=DX (KX) DR301706 

Z=DY (KY) DR3G0186 

DX (KX )=W+Z*DH12 DR30190 

DY (KY )=W*DH21+Z DR30200 

KX=KX+INCX DR30210 

KY=KY+INCY DR30220 

9¢ CONTINUE DR396230 
GO TO 14¢ DR306246 

106 CONTINUE DR30250 
DH11=DPARAM (2) DR3026@ 
DH22=DPARAM(5) DR3027@ 

DO 11@ I=1,N DR306280 

=DX (KX) DR306290 

Z=DY (KY) DR306300 

DX (KX) =W*DH11+Z DR30310 

DY (KY )=-W+DH22*Z DR3032@ 

KX=KX+INCX DR30330 

KY=KY+INCY DR30340 

11¢ CONTINUE DR3035@ 
GO TO 14¢ DR30360 

12¢ CONTINUE DR30370 
DH11=DPARAM (2) DR30380 
DH12=DPARAM(4) DR30390 
DH21=DPARAM (3) DR30400 
DH22=DPARAM(5) DR30410 

DO 13¢@ I=1,N DR3042¢ 

W=DX (KX) DR30430 

Z=DY (KY) DR30440 

DX (KX )=W*DH11+Z*DH12 DR30450 

DY (KY )=W*DH21+Z*DH22 DR30460 

KX=KX+INCX DR30470 

KY=KY+INCY DR3048@ 

130 CONTINUE DR3049¢ 
14¢ CONTINUE DR306500 
RETURN DR30510 

END DR30520 


ACM Transactions on Mathematical Software, Vol. 8, No. 4, December 1982, Pages 403-404. 
REMARK ON ALGORITHM 539 


Basic Linear Algebra Subprograms for Fortran Usage [C.L. Lawson, R.J. Hanson, 
D.R. Kincaid, and F.T. Krogh, ACM Trans. Math. Softw. 5, 3 (Sept. 1979), 324- 
325] 


David S. Dodson and Roger G. Grimes [Received 11 May 1982; revised 25 August 
1982; accepted 17 September 1982] — 


Boeing Computer Services Company, Mail Stop 9C-01, 565 Andover Park West, 
Tukwila, WA 98188. 


The companion [5] to Algorithm 539 (the BLAS) contains two errors which we 
discovered in the preparation of [1]. 

The more serious error occurs in the mathematical specifications for subrou- 
tines SROTG and DROTG, which construct Givens plane rotations. For conven- 
ience of reference, we include the relevant specifications from [5]. 


Given a and b, each of these subroutines computes 


_fegn(a) if lal>|b, 2, aap 
= {een MS lay TO (1a,b) 
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Table I. Status of BLAS Implementations 


SROTG and DROTG 
Source SSS 
Reference Documentation Code 
Boeing Computer Services (1] Correct Correct 
Dongarra et al. (2] Incorrect Incorrect 
Floating Point Systems [3] Incorrect Incorrect 
IMSL [4] Tacorrect Correct 
Lawson et.al. [5] Incorrect Correct 
Petersen [6] Correct Incorrect 
a/r if r#0, _jb/r if ro, 
-{' if r=0, s-{t if r=o, God 
s if |a|> |d|, 
z=jl1/ce if |b}=l/a| and c#0, (le) 
1 if c =0. 


If the user later wishes to reconstruct c and s from 2z, it can be done as 


follows: 
If z=1setc=Oands=1. 
If |z| < 1 set c = (1 — 2”)’” and s =z. (2) 


If |z| > 1 set c = 1/z and s = (1—c’)'”. 


The problem occurs in the computation of z. In particular, when a = 6b = 0, 
(la-e) yield the results r = 0, c = 1, s = 0, and z = 1. However, when c and s are 
reconstructed from z using (2), the incorrect values c = 0 and s = 1 result. This 
discrepancy can be resolved only by changing the computation of z, as z = 1 can 
result both when c = 0 (when a = 0 and b ¥ 0) and when c = 1 (when a = b= 0). 

Stewart [7] intended that z represent the smaller in magnitude of c and s and 
that it indicate which one of ¢ and s is the smaller, since the magnitude of the 
larger can be reconstructed stably from the smaller. He expressly omitted consid- 
eration of the point a = b = 0, which is the only point at which (le) fails. We 
propose that z be computed directly from c and s. Two observations simplify 
matters. First, the larger in magnitude of c and s is positive: |s| < |c| implies c > 
0 and 0 < |c| = |s| implies s > 0. Second, if c = 0, then s = 1. Thus the value z can 
be redefined as follows: 

Ss if |s|s<c or c=0, ; 
a= we wae Ic <5. (3) 


This definition of z in (3) differs from (la-e) only at the single point a = 6 = 0, 
where z = 0 results. For z = 0, the reconstruction formulas (2) give the correct 
values, c= 1 ands = 0. 

Even though the original mathematical specifications for subroutines SROTG 
and DROTG are incorrect, the FORTRAN and assembly language versions of 
SROTG and DROTG, available from the ACM Algorithm Distribution Service 
as part of Algorithm 539, do conform to the correct mathematical specification, 
as given in this Remark. 

BLAS documentation has appeared in several publications, and BLAS code is 
available for use or distribution from several sources. Table I lists the status of 
some of these BLAS implementations. 

A second error, more innocuous than the above, involves the dimensions of the 
arrays passed to the BLAS. In several places, the length is incorrectly specified 
as max(1, N*|INCX]). The correct length is max(1, 1+(N — 1)*|INCX)). This 
error occurs near the beginnings of Sections 5 and 7, and would be unobtrusive if 
Section 7 did not contain the word “precisely.” 
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N. K. MADSEN 

Lawrence Livermore Laboratory 
and 

R. F. SINCOVEC 

Kansas State University 
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method of lines 

CR Categories: 3.20, 3.22, 4.0, 5.17 

Language: Fortran ‘ 


DESCRIPTION 


1. Introduction 


The basic purpose of this paper is to describe and discuss PDECOL, which is a 
new computer software package for numerically solving coupled systems of 
nonlinear partial differential equations (PDE’s) in one space and one time 
dimension. The package implements finite element collocation methods based on 
piecewise polynomials for the spatial discretization techniques. The time integra- 
tion process is then accomplished by widely acceptable procedures [7] which are 
generalizations of the usual methods for treating time dependent partial differ- 
ential equations. 

PDECOL is unique because of its flexibility both in the class of problems it 
addresses and in the variety of methods it provides for use in the solution process. 
High order methods (as well as low order ones) are readily available for use in 
both the spatial and time discretization procedures. The time integration methods 
used feature automatic time step size and integration formula order selection so 
as to efficiently solve the problem at hand and yet achieve a user specified time 
integration error level. 

PDECOL consists of a collection of 19 subroutines written in reasonably 
standard Fortran, and therefore is quite portable and can be readily used on 
almost any capable computer with a Fortran compiler. No special hardware 
features are required. 
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PDECOL is designed to solve broad classes of difficult systems of partial 
differential equations that describe physical processes. This package should be of 
interest to almost anyone involved in scientific and engineering simulations, 
calculations, and model development. It should also be of interest to those 
involved in mathematical software development and, in particular, to those 
concerned with software development for partial differential equations. 

One of our main objectives in producing PDECOL was to make available a 
package which will allow users to try out a variety of collocation techniques on a 
variety of problems with little program development required. As is mentioned in 
the text, there are over 3000 different potentially useful PDE methods in 
PDECOL. Basically, we are relying on others to produce the final judgments as 
to the overall effectiveness of collocation for their problems. We feel from our 
experience that collocation looks attractive enough to warrant serious consider- 
ation by others—hence, the package PDECOL. 


2. Class of Problems 


PDECOL is designed to solve the general system of NPDE nonlinear partial 
differential equations of at most second order on the interval [x., xr] for t = b 
which is of the form 


ou 


— = f(t, x, u, Ux, Uxx), 2.1 
rv ( ) (2.1) 
where 
Uu= (uy, U2, ...,; UNPDE), 
du, du ou 
Me ee. (2.2) 
Ox Ox Ox 
07u, 87Ue 8° UNPDE ’ 
Uxx = | 7» aT ie). 
Ox” Ox Ox"; 


Each uw, is a function of the scalar quantities t and x, k = 1, 2,..., NPDE. In (2.1) 
f represents an arbitrary vector valued function whose WPDE components define 
the respective partial differential equations of the PDE system. As there is no 
explicit requirement that f actually depends on u, and/or u, x, any particular 
equation in (2.1) may actually be an ordinary differential equation (ODE), a first- 
order PDE, or a second-order PDE. 

Depending on the particular type of equation, 0, 1, or 2 boundary conditions 
may be required for each equation in the system (2.1). These are imposed at x, 
and/or xR (or not imposed at all in the case of no condition) and must be of the 
form 


b(u, u,) = z(é), (2.3) 


where b and z are arbitrary vector valued functions with NPDE components and 
u, u,, and ¢ are as above. We make the basic assumption that these boundary 
conditions (2.3) must be consistent with the initial conditions (2.4) which are 
described next. 

Each solution component u; is assumed to be a known function of x at the 
initial time t = fo. That is, 


Ur(to, X) = gz(x), k=1,2,..., NPDE, (2.4) 


where each @¢ ;,(x) is a known function of x. The initial condition functions must 
be consistent with the boundary conditions (2.3), (i.e. the initial condition func- 
tions must satisfy the boundary conditions for t = to). 

We assume that all functions are continuous in ¢ and at least piecewise 
continuous in x. With some understanding of the internal. workings of the package, 
it is possible to solve problems with inconsistent boundary and initial conditions 
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or problems with jump discontinuities in the boundary conditions with respect 
to f. 

It is obvious that the possible PDE problems described above are sufficiently 
general to include many systems for which solutions may not exist or may not be 
unique. It must be, of course, the user’s responsibility to define a mathematically 
meaningful PDE problem. 


3. Defining the PDE Problem 


The PDE systern described above is completely specified if one defines: NPDE; 
the interval [x., xr]; the initial time ¢; the vector functions f, b, and z; and the 
initial condition functions ¢;(x), k = 1, 2,..., NPDE. The PDE problem can be 
properly defined for solution by PDECOL by constructing a main program and 
three subprograms, F, BNDRY, and UINIT, which specify the above-mentioned 
quantities. 

Main Program. The construction of the main program that a user is required 
to supply is usually straightforward. The main program serves four basic purposes. 
First, initialization of the calling. arguments for PDECOL must be performed. 
Second, the main program must call the package. Third, it should provide logic 
to detect possible error returns from PDECOL. Fourth, the main program should 
perform the desired output of the computed results. A typical main program is 
shown in a later section for one numerical example. 

Required User Supplied Subroutines. The user is required to construct three 
subroutines which define the form of the PDE problem. Stated briefly, the 
purposes of these routines, F, BNDRY, and UINIT, are as follows. For given 
input values of f and x and corresponding input values of u, ux, and u,, which are 
associated with this time and spatial position: subroutine F is to compute 
appropriate values for the functions f, in (2.1); subroutine BNDRY is to compute 
appropriate values for the derivatives of the boundary condition functions b; and 
Zp in (2.3) at the left or right boundary as determined by the value of x (see (4.3) 
and (4.4)); and subroutine UINIT is to compute initial condition function values 
(2.4). 

The subroutines F, BNDRY, and UINIT are usually easily constructed and an 
example showing these routines is contained in a later section. More specific 
comments are given in the Algorithm at the end of this paper. 


4. Methods Used 


The software package PDECOL is based on the method of lines [7, 8, 11] aad 
uses a finite element collocation procedure (with piecewise polynomials as the 
trial space) for the discretization of the spatial variable x. The collocation 
procedure reduces the PDE system to a semidiscrete system (actually an initial- 
value ODE system), which then depends only on the time variable ¢. The time 
integration is then accomplished by use of slightly modified standard techniques 
[5, 6, 7], which will be discussed briefly in a later section. 

Piecewise Polynomials. The user has the opportunity to specify the piecewise 
polynomial space which is to be used to compute his approximate solution. In 
selecting this space the order, KORD, of the polynomials to be used must first be 
specified (KORD = polynomial degree + 1). Next, the number of pieces (inter- 
vals), NINT, into which the spatial domain [x., xr] is to be divided is chosen. 
The NINT + 1 distinct breakpoints of the domain must be defined and set into 
the array XBKPT in strictly increasing order, i.e. 


xx = XBKPT(1) < XBKPT(2) < --- <XBKPT(NINT + 1) = xp. 


The approximate solution at any time, ¢, will be a polynomial of order KORD in 
each subinterval [XBKPT(i), XBKPT(i + 1)], i = 1, 2,..., NINT. The number 
of continuity conditions, NCC, to be imposed on the polynomial pieces across all 
of the interior breakpoints is the last piece of user supplied data which is required 
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to uniquely determine the desired piecewise polynomial space. For example, NCC 
= 2 would require that the approximate solution (made up of the separate 
polynomial pieces) and its first spatial derivative be continuous at the breakpoints 
and hence on the entire domain [x1, xR]. NCC = 3 would require in addition that 
the second spatial derivative be continuous. The dimension of this linear space is 
known and finite and is NCPTS = KORD*NINT — NCC*(NINT — 1). The 
well-known B-spline basis [2] for this space is used by PDECOL and it consists 
of NCPTS known piecewise polynomial functions ®,(2:), i = 1, 2,..., NCPTS, 
which do not depend on the time variable ¢. Use of the B-spline basis results in 
banded (in contrast to full) matrix problems to be solved in the package. The 
computer program requires 3 = KORD s 20, 1< NCC < KORD, and NINT = 1. 

Collocation over Piecewise Polynomials. The basic assumption made is that 
at any given time ¢, each approximate solution component, uz, is a piecewise 
polynomial in the user specified space and hence can be written in terms of the 
B-spline basis functions as 

NCPTS 


u(t, x)= YY ciz(t) B(x), k=1,2,..., NPDE. (4.1) 
i=] 
The unknown coefficients c;, depend only on the time ¢, and the known basis 
functions ®; depend on x. The semidiscrete equations (actually ordinary differ- 
ential equations) which determine these coefficients, c;,,, for 1 = 1, 2,..., NCPTS 
and k = 1, 2, ..., NPDE, are obtained by collocating, ie. by requiring the 
approximate u,(ft, x) in (4.1) to satisfy the PDE’s (2.1) and the boundary 
conditions (2.3) exactly, at a set of NCPTS collocation points. 
To be more specific, we choose NCPTS collocation points such that 


xp = 8 <b< +++ < Encprs = XR 
and ®,(&;) ¥ 0 for i = 1, 2,..., NCPTS. Then, substituting (4.1) into (2.1) and 


requiring (2.1) to be valid at the interior collocation points gives 


NCPTS d. Cik 
t, 


ye ®;(€;) aT Teh &;, u(é, £;), ux(é, §5), Uxx(E, §5)), 
J=2,3,..., NCPTS—1, k=1,2,...,NPDE. (4.2) 


To determine the equations corresponding to 7 = 1 and j = NCPTS, we form 
equations which depend on the type of boundary condition. It will suffice to show 
the technique we use for the left boundary, x = x, where j = 1, since those for the 
right boundary, x = xR where j = NCPTS, are completely analogous. 

Normally, we form an ODE corresponding to the point x = x, by differentiating 
the boundary conditions (2.3) with respect to ¢, which gives 


NPDE 
dbx ou; Ob; OU, a azn (4.3) 
au; “Ot dux, dt 


j=l 
Substituting (4.1) into (4.3) and using the facts [1, 3] that ®,(x_) ¥ 0, ®,(x._) = 0, 


i= 2, 3,..., NCPTS, and that ®; (x_) 4 0, ®4(x_) ¥ 0, Bi (x_) = 0, 2 = 3, 4,..., 
NCPTS gives the appropriate ODE: 


NPDE { 9b, Abe ., = NPDE { 9b, Seas dzr 
» {3 ®,( xz) Taig | od + » Ou. Ux, — O)(x L) t dt’ (4.4) 


In the special case when no boundary condition is desired for the k = kp equation, 
we simply collocate in the usual manner at the boundary point and obtain (4.2) 
with 7 = 1 and k = & for our equation corresponding to the point x = x1. 

Combining the boundary condition equations with (4.2) yields a semidiscrete 
system of N = NPDE*NCPTS time dependent ordinary differential equations 
which have the form 
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—_—= t ‘ : 
A a g(t, c) (4.5) 


The matrix A in (4.5) and the Jacobian matrix of g, dg/dc, are matrices with a 
maximum bandwidth of 2* (KORD — 1)*NPDE — 1 except when KORD = 3 and 
an equation with no boundary condition at one endpoint exists. Except for the 
first and last block rows, all of the entries of A are simply basis function values at 
the collocation points. The first and last block rows of A consist of the appropriate 
boundary condition equation coefficients from (4.4) or (4.2). Since at any point at 
most KORD basis functions have nonzero values, each block row of A consists of 
KORD NPDE by NPDE matrices. 

We remind the reader that the unknowns in (4.5) which are actually computed 
by PDECOL are the basis function coefficients in (4.1) and not the actual 
approximate solution values. However, with a knowledge of these coefficients, we 
can then easily evaluate the approximate solution values by using (4.1). 

Accuracy Considerations. There are two sources of error in the approximate 
solutions generated by PDECOL. The first is due to the time discretization 
methods used and the second is due to the collocation spatial discretization 
technique. PDECOL attempts to control the time discretization error and to 
maintain it below a user specified level by dynamically selecting appropriate time 
step sizes and time integration formulas. We refer the reader to the package 
documentation for the details on how this is accomplished. Control of the error 
introduced by the spatial discretization is a more difficult problem, and we make 
the following observations. 

Piecewise polynomials of order KORD have the approximation property [13] 
that sufficiently smooth functions can be approximated by these polynomials 
such that the spatial errors in the approximation are proportional to h*°*”, where 
h = max{XBKPT(i + 1) — XBKPT(i)]. Derivatives of order 7 of these smooth 
functions are also approximated with spatial errors which are proportional to 
hAXORP-), We can use these approximation properties to estimate the expected 
orders of accuracy (for the spatial discretization) of the collocation techniques 
implemented in PDECOL. In particular, when using a piecewise polynomial space 
of order KORD, since eq. (2.1) involves second-order spatial derivatives, we 
expect PDECOL to generate approximate solutions with spatial errors which are 
proportional to h*°”?-?, However, for the special spaces with KORD > 3 and 
NCC = 2, a special choice of collocation points (Gauss-Legendre quadrature 
points in each subinterval) generates approximate solutions with spatial errors 
which are proportional to h*°”” for certain classes of PDE problems [4]. 

We emphasize that the piecewise polynomial space used in PDECOL (which 
is selected by the user) will determine the magnitude of the spatial discretization 
errors in the computed approximate solution. The package has no control over 
errors introduced by the user’s choice of the piecewise polynomial space. 


5. Limitations and Use of PDECOL 


Of course, it goes without saying that no one program such as PDECOL will solve 
all PDE problems. There are several reasons for this, and we will enumerate 
them. : 

First, in order to be “solvable” a.PDE problem should be properly posed in a 
mathematical sense. There is nothing that PDECOL can do to insure or detect 
that a user’s problem is properly posed and so we reiterate that this responsibility 
must fall back to the user. Discussion of what constitutes a properly posed 
problem is beyond the scope and intent of this paper and we refer the interested 
reader to any good PDE textbook. 

Second, PDECOL (and almost any general purpose software package) imposes 
certain restrictions on the classes of problems it allows. These restrictions are 
enumerated in Section 2. Perhaps the most unpleasant of these restrictions is the 
form of the boundary conditions (2.3) and the fact that the boundary conditions 
must be consistent with the initial conditions. Maintaining high order approxi- 
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mations at the boundary is a difficult problem in solving PDE’s, and the above 
restrictions result from our approach to accomplish this. 

All problems do not fit these restrictions. For example, certain hyperbolic 
systems of PDE’s require (for stability) that the boundary conditions be imposed 
through the use of characteristic transformations at the boundary. We know of 
no way to implement the use of characteristic variables for the boundary condi- 
tions with the current structure of PDECOL. Another limitation is that PDECOL 
is restricted to problems in at most one space dimension. The extension to higher 
dimensions of the method of lines approach with either collocation or finite 
differences is conceptually quite simple. The basic difficulty arises from the fact 
that this basic approach yields a fully implicit discretization method. This, of 
course, implies that a possibly very large matrix problem must be solved. We feel 
certain that there are classes of PDE problems where fully implicit methods will 
be necessary, and for these problems extensions of these current techniques 
would prove fruitful. For other classes of problems, splitting or alternating 
direction implicit techniques may be much more efficient. 

If a user’s problem does not fit the prescription of the package, he has the 
following options: (a) find another package, (b) modify the existing package to 
suit his needs, or (c) modify or transform the problem to fit the package. The .- 
complexity of PDECOL and the limit of space precludes presenting details on 
how to modify PDECOL to accommodate problems which may not satisfy the 
above restrictions. 

Third, the methods implemented in a program may not be adequate for a 
particular problem. Collocation methods (as implemented in PDECOL) will not 
work for all problems. For example, some PDE problems are quite sensitive to a 
particular conservation law being satisfied by the discrete approximation (con- 
servation of mass, energy, particles, etc.). Collocation techniques are inherently 
nonconservative and difficulties can be expected if such sensitivities exist for a 
problem. 

Summarizing, our experience in using general purpose software such as 
PDECOL over several years has led us to believe that general purpose software 
is somewhat more difficult to use because of its generality. Therefore, the 
probability for errors and misuse is greater and so its primary advantage (its 
general nature) also becomes a disadvantage. We have found that users have 
difficulties primarily for three reasons: (1) their problem is not well posed, (2) the 
methods in the general package will not work for their problem, and (3) the user 
has made programming errors or misused the package. Perhaps 99 percent of all 
difficulties fall into the third category. 


6. Structure of PDECOL 


Since the methods in PDECOL are based on the method of lines, PDECOL is 
structured much like some of the recently developed integrators for ordinary 
differential equations. This structure includes a driver subroutine, a core integra- 
tor which advances the time by a single time step, and miscellaneous routines 
which assist in setting up and solving nonlinear and linear equations. 

PDECOL is somewhat more complicated than the typical ODE integrator 
since: (a) PDE’s are being solved, and (b) a finite element method requiring the 
evaluation of the piecewise polynomials (4.1) is being used. The interconnections 
and lines of communication in PDECOL are quite complicated and difficult to 
understand when viewed as a whole. However, when the driver program and the 
core integrator are isolated, the picture becomes more clear. Figures 1 and 2 
illustrate all of the package and user routines and their interconnections. Some 
of the routines are duplicated in each figure. A brief summary of the basic 
functions of all of the package subroutines is contained in the Algorithm. We will 
now describe the principal routines in PDECOL. 

Main Components. PDECOL. This routine is a driver for the entire package. 
It serves the following purposes. The locations and lengths of the storage arrays 
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required by the package are allocated and defined in PDECOL. On the first call 
to the package, this routine checks the user’s input for legality and performs 
initialization tasks such as setting problem parameters and calling the package 
routine INITAL. After the initialization is complete, PDECOL makes repeated 
calls to the core integrator routine STIFIB in order to advance the time variable 
a single step at a time until the user’s desired output time is reached. At this time 
(since output times are not usually hit exactly) the package routine INTERP is 
called to interpolate the computed basis function coefficients to the desired 
output time. PDECOL also checks for possible error returns from STIFIB and 
either attempts to recover or provides the user with appropriate flags and/or 
messages. 

VALUES. This is the routine the user must call in order to obtain the values 
of his computed approximate solution and its derivatives when his desired output 
time TOUT has been reached. VALUES performs the same basic function as 
EVAL (see below) except that it can evaluate the piecewise polynomial solution 
at any given spatial point or points—rather than just at collocation points. Since 
the computed solution is actually a continuous function, the user may desire 
solution values at arbitrary spatial points in the domain of interest. VALUES is 
structured much like EVAL. The basis function values are generated by BSPLVD 
as needed, and the user has the option of obtaining values at any number of 
points with a single call to VALUES. 

INITAL. This routine performs functions which are very important to the 
entire package. Its main purpose is to determine the initial condition data for the 
package. This initial data consists of the basis function coefficients which are 
chosen so that the initial piecewise polynomial ((4.1) at ¢ = f&) interpolates the 
user’s initial condition functions (2.4) at the collocation points. This requires that 
the collocation points and all of the basis function data be generated. INITAL 
generates (or causes to be generated) and stores the breakpoint sequence, the 
collocation points (see COLPNT), and the B-spline basis function and derivative 
values at the collocation points [3]. The basis function values and derivatives at 
the collocation points are calculated only once and saved so as to make the 
package efficient (see EVAL below). 

COLPNT. The collocation points which are required by the collocation discre- 
tization procedure are calculated in this routine. In general we choose the 
collocation points to be the points in the domain [x,, xr] at which the B-spline 
basis functions attain their unique maxima [1]. For the special piecewise poly- 
nomial spaces of order KORD with NCC = 2, a second more desirable choice is 
available (normal default choice). In this case the collocation points are chosen 
to be the unique KORD — NCC Gauss-Legendre quadrature points in each 
subinterval [XBKPT(i), XBKPT(i + 1)], for i = 1, 2, .... NINT, plus the two 
endpoints x;, and xr. This choice of points for these piecewise polynomial spaces 
will produce more accurate approximate solutions for certain classes of problems 
[4]. 
BSPLVD, BSPLVN, and INTERV. These subprograms are the basic routines 
which are used to generate the B-spline basis function values and their derivative 
values at any desired points. They were developed and fully documented by 
deBoor [8] and are essentially unchanged from his original implementation. They 
provide for the reliable evaluation of arbitrary B-spline basis function values for 
polynomial orders up to 20. 

STIFIB. This routine is the core integrator for the package. Its basic task is to 
advance the time value by taking a single time step. The routines STIFIB, 
COSET, DIFFUN, RES, ADDA, PSETIB, INTERP, DECB, and SOLB actually 
constitute a slightly modified version of an ODE package called GEARIB which 
has been developed by Hindmarsh [6]. The package GEARIB is designed to solve 
initial-value ODE problems of the form 


dy 
A we g(t, y), (6.1) 
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where A(¢, y) is a banded matrix, y is a vector, and g is a vector valued function. 
The semidiscrete equations (4.5) obtained by the collocation procedure above are 
particular examples of such equations. The time integration algorithms that are 
implemented in STIFIB are quite complex and we will discuss only the more 
important features. The methods used to advance the time are based on multi- 
point formulas of the form 

ky ko 

Yn = Yi Yn + At ¥) Biyny, (6.2) 

J=1 j=0 
where y; is an approximation to the exact value at t = t, y’ denotes dy/dt, 
At = t, — t-1, and a; and f; are the method coefficients. Since Bo ¥ 0 for the 
methods used, the time integration methods (6.2) are implicit and so a nonlinear 
system of equations must in general be solved for every time step taken. 

Proper choices of the coefficients in (6.2) can produce the standard Crank- 
Nicolson and backward difference methods so these techniques are generaliza- 
tions of the classical, often used time integration methods. 

There are two basic types of time integration formulas used in STIFIB. The 
first type of formula (Adams’ methods) of order g, 1 = g = 12, is obtained from 
(6.2) by setting ki = 1, ko = q — 1, and a = 1. The second type of formula 
(backward differentiation methods) of order g, 1 <= qg = 5, is obtained by setting 
k, = q and kz = 0. The remaining unspecified coefficients may be found in the 
book by Gear [5]. In general we recommend the use of the second type of formulas 
because of their better stability properties. 

The time integration techniques in PDECOL feature automatic time step size 
and time integration formula order selection so as to efficiently solve the problem 
and yet achieve a user specified time integration error level. 

For more specific details of the techniques and procedures implemented in 
STIFIB, we refer the reader to the comments in the program and the GEARIB 
report [6]. : 

GFUN. The primary function of the routine GFUN is to properly evaluate the 
function g(t, y) of (6.1) when provided with input values of ¢ and y. In the 
package the vector function g(¢, y) actually consists of values at the collocation 
points of the right-hand-side function f, which defines the original PDE problem 
(2.1). Since the quantities actually being computed by the package (and the 
arguments input to GFUN) are basis function coefficients, GFUN must use these 
coefficients and the user defined subprograms F and BNDRY to generate the 
proper output values of g(t, y). The basis function coefficients are converted to 
piecewise polynomial values by EVAL (see below) and these values are then used 
to call the user’s routines F and BNDRY. This conversion and evaluation process 
is performed at each collocation point in succession with BNDRY being called 
only for the boundary points. The first and last block rows of the A matrix (6.1) 
are also updated by GFUN to properly account for the boundary conditions (2.1). 

GFUN is the routine which actually implements the collocation discretization 
process. It serves as the basic interface (via the method of lines) between the 
users’ routines F and BNDRY and an ODE integrator (in this case a modified 
GEARIB). It serves the same interface role as the routine PDEONE [12] in a 
similar finite difference—method of lines implementation. 

EVAL. The purpose of EVAL is to evaluate the piecewise polynomial (4.1) 
and its first two derivatives at a given collocation point, when the current basis 
function coefficients are provided as input. Since at any given point, at most 
KORD basis functions are nonzero, this computation involves computing three 
vector inner products where the vectors are of length KORD. This computation 
is the “innermost loop” in the package, since EVAL is called just prior to each 
call to the user’s routine F (or BNDRY). Originally, the basis function values 
were not stored and were repeatedly computed (by BSPLVD) as needed. How- 
ever, the expense of this repeated computation was so great that overall run times 
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were decreased by factors of from five to ten when it was decided to store all of 
the basis function (and derivative) values at the collocation points (see INITAL). 
This gain in speed is, of course, at the expense of additional storage. 

PSETIB. This routine is required by STIFIB to compute and process the 
matrix A — ABo (dg/dy) where A is the banded matrix in (6.1) and dg/dy is the 
banded Jacobian matrix of the function g(¢, y) in (6.1). If the values of the partial 
derivatives of the user’s function f in (2.1) with respect to u, ux, and ux, are 
known, then the Jacobian matrix dg/dy can easily be computed using the chain 
rule. Once PSETIB has formed the desired matrix, it then LU decomposes the 
matrix for use in STIFIB by calling the package routine DECB. There are two 
options available in PSETIB for generating the needed partial derivatives and 
the user makes the selection. One option requires that the user construct a 
routine DERIVF to provide the partial derivative information (see the Algo- 
rithm). In the second option approximate partial derivatives are generated 
internally in the package routine DIFFF by finite difference quotients obtained 
by calling the user’s routine F. The DERIVF option is ory slightly more efficient 
(at most 10 percent faster). However, it does have the advantage that more 
accurate partial derivative values will be obtained. Inaccurate Jacobian matrix 
values do not directly affect the accuracy of the computed approximate solution, 
but can cause longer running times by forcing the package to take smaller time 
steps and to generate Jacobian matrices more frequently. For most problems we 
have found the second option totally adequate and recommend its use. 


7. Example Problems 


To illustrate the use of PDECOL, we present a main program and the user 
written subroutines required to solve the following problem on the interval 
[0, 1]: 

du, au dv du 


— = py? — + 2v—— — uw — u’? +:10, 
ot Ox Ox OX 


dv Av du dv 0°u ; 
— =u 5 Ae ee Es =" 
ot ox Ox ax Ox 


with boundary conditions 


u=, v=7 atx=0, 
ou 0U 
—+sin(uwv)=4, —-— = = 
an (uv) = 5 ae cos(uv) =1 atx=1 
and initial conditions 
u=3(x+1), v=qa_ att=0. 


Note that the initial conditions are consistent with the boundary conditions as 
required by PDECOL. . 

Figure 3 shows a main program and the user written subroutines F, BNDRY, 
UINIT, and DERIVF for this problem. Subroutine DERIVF is an optional 
routine which needs to be provided only if MF = 11 or 21 (see internal computer 
documentation for additional details). We present it here for completeness. 

In Figure 4 we present some numerical results for this problem. These results 
were obtained using the piecewise polynomial space defined by KORD = 4, NCC 
= 2, and NINT = 30 with equally spaced breakpoints. The reader is referred to 
the internal program documentation in PDECOL for the definition of the quan- 
tities that appear in the figure. Since we do not know the exact solution to this 
problem, we are not able to determine the error in the calculated solution. 

We next consider a relatively simple PDE problem where we know the exact 
solution. The purpose of this problem is to show the use of higher order methods 
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PROGRAM TEST (UGOUT , TAPE3=UGOUT) 
COMMON /ENDPT/ XLEFT 
COMMON /GEARO/ DTUSED,NQ,NSTEPS,NF,NJ 
DIMENSION U(2,31),XBKPT(31),SCTCH(10),WORK(5000) , IWORK(500) 
C 
C INITIALIZE PARAMETERS AND PDECOL CALLING ARGUMENTS 
C 
NPDE = 2 
30 
NINT + 1 


= 
Ky 
= 
h 
noun i 


INDEX = 1 

IWORK(1) = 5000 

IWORK(2) = 500 

DX = 1.0 / FLOAT(NPTS-1) 

DO 10 I=1,NPTS 

XBKPT (I) = FLOAT(I-1) * DX 

10 CONTINUE 

XLEFT = XBKPT(1) 


CALL THE PACKAGE TO INTEGRATE TO TIME T = TOUT 


QAAQ 


20 CALL PDECOL(T0, TOUT, DI, XBKPT, EPS, NINT,KORD,NCC,NPDE,MF, INDEX 
A WORK, IWORK) 


CHECK FOR EXECUTION ERRORS 


AWA 


IF ( INDEX .NE. 0 ) GO TO 70 


OUTPUT PERFORMANCE DATA AND COMPUTED SOLUTION VALUES 


QAQ 


WRITE (3,30) TOUT, DTUSED, NSTEPS 
30 FORMAT(//10X, 3HT= ,E10.3,7H  DT= ,E10.3,15H TOTAL STEPS=,I5) 
CALL VALUES (XBKPT,U,SCTCH,NPDE,NPTS,NPTS,0,WORK) 
DO 60 K=1,NPDE 
WRITE (3,40) K 
40 FORMAT(/10X,13HPDE COMPONENT, I2/) 
WRITE (3,50) (U(K,I),I=1,NPTS) 
50 FORMAT (10X,5E12. 4) 
60 CONTINUE 


SET NEW OUTPUT TIME AND CONTINUE THE INTEGRATION IF TOUT .LT. 11.0 
OTHERWISE, TERMINATE THE PROBLEM 


AQAA 


TOUT = TOUT * 10.0 

TP POUL .E8. 11.0) G0 LO 20 
70 WRITE(3,80) INDEX 
80 FORMAT (10X,7HINDEX= ,I3) 

STOP 

END 


SUBROUTINE F(T,X,U,UX,UXX, FVAL, NPDE) 
DIMENSION U(NPDE), US(NPDE), UXX(NPDE), FVAL(NPDE) 


FVAL(1) = U(2)*U(2)*UXX(1) - U(1)*U(2) - U(1)**2 + 10.0 
‘ + 2,0*U(2)*UX (2) *UX (1) 
FVAL(2) = U(1)*U(1)*UXX(2) + U(1)*U(2) - U(2)**2 
a + UXX(1) + 2.0*U(1)*UX (1) *UX (2) 
RETURN 
END 


Fig. 3. Main program and user written subroutines for the first example problem 
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SUBROUTINE BNDRY(T,X,U,UX,DBDU,DBDUX ,D2ZDT,NPDE) 


DIMENSION U(NPDE), UX(NPDE), DZDT(NPDE) 


DIMENSION DBDU(NPDE,NPDE'), DBDUX(NPDE,NPDE) 


COMMON /ENDPT/ XLEFT 
IF ( X .WE. XLEFT ) GO TO 10 


DBDU (1,1) 
DBDU (1, 2) 
DBDU (2,1) 
DBDU (2, 2) 
DBDUX (1,1) 
DBDUX (1,2) 
DBDUX (2, 1) 
DBDUX (2, 2) 
DZDT (1) 
DZDT (2) 
RETURN 
DBDU (1,1) 
DBDU (1, 2) 
DBDU (2,1) 
DBDU (2,2) 
DBDUX(1,1) = 
DBDUX (1,2) = 
DBDUX (2,1) = 
DBDUX (2,2) = 
DZDT (1) 
DZDT (2) 
RETURN 
END 


= 7, 


hou out 
moses 


oo 0 9" 


nou 
a 
NS 
Ki 
nN 
a ae es 


0 


cos( U(1) * U(2) ) 
cos( U(1) * U(2) ) 
SIN( U(1) * U(2) ) 
SING UCL) * UC22) 


SUBROUTINE UINIT(X,U,NPDE) 
DIMENSION U(NPDE) 


INITIAL CONDITIONS. NOTE THAT PI = 4.0*ATAN(1.0) 


U(1) = 0.5 * (X= 1.0) 
U(2) = 4.0 * ATAN( 1.0 ) 
RETURN 

END 


SUBROUTINE DERIVF(T,X,U,UX,UXX,DFDU, DFDUX , DFDUXX , NPDE) 


DIMENSION U(NPDE), UX(NPDE), UXX(NPDE) 


DIMENSION DFDU(NPDE,NPDE), DFDUX(NPDE,NPDE), DFDUXX(NPDE,NPDE) 
-U(2) = 2.0*U(1) 
2.0*U(2)*UXX(1) - U(1) + 2.0*UX(2)*UX(1) 
2.04U(1)*UXX(2) + U2) + 2.0*UX(1)*UX (2) 


DFDU (1, 1) 
DFDU (1, 2) 
DFDU (2, 1) 
DFDU (2,2) 


noueou tl 


U 


DFDUX (1,1) 
DFDUX (1, 2) 
DFDUX (2,1) 
DFDUX (2, 2) 


DFDUXX (1,1) 
DFDUXX (1,2) 
DFDUXX (2,1) 
DFDUXX (2, 2) 
RETURN 
END 


(1) - 2,0%*U(2) 


2.0*U(2)*UX (2) 
2.0*U(2)*UX (1) 
2.0*U(1)*UX (2) 
2.04U(1)*UX (1) 


U(2)*U(2) 
0.0 
1.0 
U(1)*U(1) 


Fig. 3. (Continued) 
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and the execution times on a CDC-7600 computer. The problem is of a simple 
diffusion type and is described by 


duedusisdst 
—=— 5 + 7° Sin 7X, 
ot Ox 
u(0, x) = 1, u(t, 0) = u(t, 1) = 1 


for 0 <x < 1andt> 0. The exact solution for this problem is easily seen to be 


u(t, x) = 1+ (sin 7x)(1 — e7"). 

Table I shows the results obtained for this problem at t = 0.1 with NCC = 2 for 
several values of KORD and NINT. Equally spaced breakpoints and MF = 21 
were used in all cases. The values of EPS, the time integration error tolerance, 
were determined by trial and error to be as large as possible without affecting 
the spatial errors. The initial DT was chosen to be equal to EPS/2. NSTEPS is 
the number of time integration steps. The time, TIME, is the computer time in 
seconds (CDC-7600) required to produce the solution. The error, ERROR, is the 
maximum absolute difference between the exact solution and the numerical 
solution. The calculated order of convergence is shown in the last column. The 
numbers in parentheses are the theoretical values. 

The preceding two examples illustrate the use of PDECOL and demonstrate 
the qualitative behavior of the higher order collocation methods that are imple- 
mented in the package. To consider all combinations of PDE methods that are 
built into PDECOL is virtually impossible since there are potentially over 3000 
different methods in the package. We refer the reader to several other papers [9, 
10] for additional results on the use, testing, and evaluation of PDECOL to solve 
partial differential equations and two-point boundary value problems. Some 
comparisons of PDECOL with low order finite difference methods are contained 


T= 1.000E-03 DT= $8.400E-04 TOTAL STEPS= 11 

PDE COMPONENT 1 
0.O0000E-01 5.1915E-01 5.8759E-01 5.5547E-01 5.7294E-01 
©.9012E-01 6.0709E-01 6.23938E-01 6.4067E-01 6.85736E-01 
6.7402E-01 6.9065E-01 7.0726E-01 7.2386E-01 7.4046E-01 
7.0706E-01 7.7865E-01 7.9024E-01 8.0683HE-01 8.2342E-01 
8.4002E-01 8.5661E-01 8&.7321E-01 8.8982E-01 9.0645E-01 
9.2809E-01 9.9877E-01 9.5651E-01 9.7332E-01 9.9026E-01 
1.0074E+00 

PDE COMPONENT 2 
3.1416E+00 3.13835E+00 3.1331E+00 3,.1332E+00 3.1334E+00 
6.1835E+00 38.1336E+00 8.1337E+00 3.1337E+00 3.1338E+00 
8.138388E+00 8,.13839E+00 8.1340E+00 3.13840E+00 3.13541E+00 
8.13841E+00 3.1842E+00 38.1342E+00 3.1343E+00 3.1843E+00 
8.13844E+00 3.13844E+00 8.1345E+00 3.1845E+00 3.1846E+00 
8.13847E+00 8.1347E+00 38.1348E+00 3.1349E+00 3.13849E+00 
3. 1850E+00 

T= 1.000E-02 DT= 2.052E-038 TOTAL STEPS= 

PDE COMPONENT 1 
©.0000E-01 5.2478E-01 65.4920E-01 5.7800E-01 5.9609E-01 
6.1848E-01 6.4020E-01 6.61382E-01 6.8189E-01 7.0198E-01 
7.2165E-01 7.4097E-01 7.5999E-01 7.7877E-01 7.9738E-01 
8.1588E-01 9.8483E-01 8.5280E-01 8.7135E-01 8.9007E-01 
9.0902E-01 9.2829E-01 9.4797E-01 9.6817E-01 9.8898E-01 
1,0105E#00 1.0330E+00 1.0564E+00 1.0810E+00 1.1070E+00 
1.1845E+00 


Fig. 4. Numerical results for the first example problem (continued on p. 342) 
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PDECCOMPONENT 2 


5. 1416E+00 
3.0604E+00 
5. 0649E+00 
3. 0692E+00 
3.0738E+00 
3.0785E+00 
5. 0861E+00 


T= 1.000E-01 


PD 


EH COMPONENT 
- OO00E-01 
-0419E-01 
- O0O96E+00 
- 2808E+00 
- 4127E+00 
- 0098E+00 
-67883E+00 
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PDE COMPONENT 


- 1416E+00 
- 7645E+00 
» 7607E+00 
-8977E+00 
. O99 1E+00 
- d080E+t00 
- 6584E+00 
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T= 1.000E+00 


PDE COMPONENT 


©. 0000E-01 
7.0420E-01 
1.0074E+00 
1.2221E+00 
1. 8957E+00 
1.5351E+00 
1.6479E+00 


E COMPONENT 
5. 1416E+00 
2. 7098E+00 
2. 7887E+00 
2.9436E+00 
3. 1669E+00 
5.4341E+00 
3. 7432E+00 


1. 000E+01 


E COMPONENT 
5.0000E-01 
7. 5420E-01 
1.0074E+00 
1.2221E+00 
1. 8957E+00 
1.53851E+00 
1.6479E+00 


COMPONENT 
. 1416E+00 
- 70O98E+00 
- 78387E+00 
- 9436E+00 
- L669E+00 
- 4341E+00 
- 7432E+00 
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INDEX= 0 


3.0948E+00 
3.0611E+00 
3.0658E+00 
3.0700E+00 
3.0742E+00 
3.0798E+00 


DT= 


1 

5.4709E-01 
8.0704E-01 
1.0570E+00 
1.2702E+00 
1. 4447E+00 
1. 5855E+00 


2 

3. 0064E+00 
2.7475E+00 
2.7847E+00 
2.9882E+00 
3. 1459E+00 
3.4104E+00 


DT= 


id 

0. 4699E-01 
8. 0695E-01 
1.05388E+00 
1. 2599E+00 
1.4261E+00 
1. 5596E+00 


2 

3.0030E+00 
2. 7460E+00 
2. 8085E+00 
2.9842E+00 
38.2170E+00 
3.4925E+00 


DT= 


d 

0.4699E-01 
8.0695E-01 
1.0538E+00 
1. 2599E+00 
1.4261E+00 
1.5596E+00 


2 

3.0030E+00 
2. 7460E+00 
2. 8085E+00 
2.9842E+00 
3.2170E+00 
3. 4925E+00 


7,857E-03 


5. 066E-01 


3. 566E+00 


8.0722E+00 
3. 0620E+00 
5. 0667E+00 
3.0708E+00 
5.0752E+00 
3.0811E+00 


©. 9690E-01 
8. 5929E-01 
1. 1028E+00 
1. 38081E+00 
1,47538E+00 
1.6102E+00 


2.9094E+00 
2. 7409E+00 
2.8079E+00 
2,.9713E+00 
38. 1948E+00 
3.469 3E+00 


©.9679E-01 
8. 5895E-01 
1, 0985E+00 
1.2962E+00 
1,4551E+00 
1,5830E+00 


2.9085E+00 
2. 7435E+00 
2.8374E+00 
3.0270E+00 
3. 2688E+00 
35. 0020E+00 


5.9679E-01 
8, 5895E-01 
1. 0985E+00 
1. 2962E+00 
1.4551E+00 
1.5830E+00 


2.9085E+00 
2.7434E+00 
2.8374E+00 
3.0270E+00 
3. 2688E+00 
3. 0025E+00 


3.0634E+00 
3.0630E+00 
3.0675E+00 
3.0716E+00 
5.0763E+00 
3.0825E+00 


TOTAL STEPS= 


6.4852E-01 
9,1062E-01 
1.1471E+00 
1, 38444E+00 
1.5047E+00 
1.6339E+00 


2. 8409E+00 
2.742Z8E+00 
2.8347E+00 
3.0117E+00 
3. 2457E+00 
38. 0505E+00 


TOTAL STEFS= 


6.4846E-01 
9.0965E-01 
1.1414E+00 
1. 8868E+00 
1.4830E+00 
1.6055E+00 


2.8341E+00 
2. 7000E+00 
2.869 9E+00 
3.0718E+00 
3.3228E+00 
3.6143E+00 


TOTAL STEPS= 


6,4846E-01 
9.0965E-01 
1.1414E+00 
1. 38308E+00 
1, 4820E+00 
1.6055E+00 


2.8341E+00 
2. 70GOE+00 
2.86G9E+00 
3.0718E+00 
3. 38223E+00 
3.6143E+00 


Fig. 4. (Continued) 


5, 0606E+00 
3, 0640E+00 
3.0684E+00 
5.0724E+00 
5.077 3E+00 
3.0842E+00 


7.0117E-01 
9.6079E-01 
1.1897E+00 
1.3879 3E+00 
1,53828E+00 
1.6566E+00 


2.7948E+00 
2.7014E+00 
2.8647E+00 
3.0545E+00 
3. 2986E+00 
3. 09388E+00 


7.0117E-01 
9. 0940E-01 
1.1826E+00 
1. 3640E+00 
1. 5096E+00 
1.6271E+00 


2.7879E+00 
2.76 38E+00 
2.9054E+00 
3.1184E+00 
3.3774E+00 
3.6778E+00 


7,0117E-01 
9,.5940E-01 
1.1826E+00 
1. 8640E+00 
1.5096E+00 
1.6271E+00 


Z.7879E+00 
2.76 38E+00 
2.9054E+00 
3.1184E+00 
5.3774E+00 
3.6778E+00 
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Table I. Results at t = 0.1 for the Second Example Problem with NCC = 2 for Several Values of 


KORD and NINT 
Order of con- 

KORD NINT EPS NSTEPS TIME (sec) ERROR vergence 

3 10 3x 10° 15 3.33 X 107? 1.14 x 107° 

3 20 1x 10° 19 7.56 x 10°? 2.94 x 1074 1.96 (2) 

4 8 1x 10° 25 9.53 x 10°? 2.19 x 10°° 

4 16 1x10’ 33 2.32 x 107 1.53 x 10° 3.90 (4) 

5 4 1x 10° 25 8.44 x 10°? 1.38 x 107° 

5 8 1x10° 44 2.50 x 107! 4.33 x 1077 5.00 (5) 

6 2 1« 107° 25 6.61 X 107? 1.85 x 107° 

6 4 1x 10° 41 1.84 x 107! 4.13 x 107’ 5.50 (6) 


in [9]. Our basic feelings are that for smooth problems and high accuracy 
demands, the higher order collocation techniques will be significantly more 
efficient, that is, produce more accuracy per unit of run time. 

Our experience in using PDECOL has led us to firmly believe that PDECOL is 
a versatile software package that can solve a broad class of nonlinear partial 
differential equations. Its higher order methods can produce extremely accurate 
solutions quite efficiently when compared to lower order methods. The package 
is quite portable. 
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ALGORITHM 


[Summary information and a part: of the listing is printed here. To facilitate 
understanding of the partial listing! given here, lines 6110-6180 of the complete 
listing have been substituted for lines 4050-4060 of the complete listing, which is 
available from the ACM Algorithms Distribution Service. ] 


NAME(n): indicates a Fortran module with n records 
NAME”(n): indicates “NAME” contains test data 
NAME™(n): indicates “NAME” contains machine dependent data 


COLLECTED ALGORITHMS (cont.) 


Contents: PDECOL (924), VALUES (70), BLOCKD™ (19), INITAL (84), 
COLPNT (222), BSPLVD (72), BSPLVN (46), INTERV (88), 
STIFIB (416), GFUN (70), EVAL (28), DIFFUN (28), ADDA 
(45), RES (53), PSETIB (102), DIFFF (46), INTERP (31), 
COSET (179), DECB (87), SOLB (47) 
Test package: TEST1 (56), F1 (8), BNDRY1 (28), UINITI (9), DERIVF1 (19), 
TEST2 (61), F2 (6), BNDRY2 (6), UNINIT2 (5), DERIVF2 (6), 
TRUSOL2 (5), TSIN2” (21), TESTS (61), F3 (10), BNDRY8 (27), 
UINITS (5), DERIVES (17), TRUSOL3 (6), TSIN3” (25), TEST4 
(64), F4 (5), BNDRY4 (12), UINIT4 (5), DERIVF4 (6), TRUSOL4 
(11), TSIN4? (19), TEST5 (61), F5 (5), BNDRY5 (13), UINIT5 
(5), DERIVF5 (6), TRUSOLS (5), TSINS? (24) 
SUBROUTINE PDECOL(T@, TOUT,DT,XBKPT,EPS,NINT,KORD,NCC,NPDE,MF, 10 
* INDEX, WORK, IWORK) 20 
C 30 
(--------~~--------~----------~---------------------~--.----------------- 4 
Ces see ee a ee eee oes 50 
Cc 6¢ 
C THIS IS THE MARCH 24, 1978 VERSION OF PDECOL. 7¢ 
Cc 89 
C THIS PACKAGE WAS CONSTRUCTED SO AS TO CONFORM TO AS MANY ANSI-FORTRAN 90 
C RULES AS WAS CONVENIENTLY POSSIBLE. THE FORTRAN USED VIOLATES ANSI 1060 
C STANDARDS IN THE TWO WAYS LISTED BELOW.... 110 
Cc 120 
C 1. SUBSCRIPTS OF THE GENERAL FORM C*V1 + V2 + V3 ARE USED 13¢ 
Cc (POSSIBLY IN A PERMUTED ORDER), WHERE C IS AN INTEGER CONSTANT 14¢ 
Cc AND V1, V2, AND V3 ARE INTEGER VARIABLES. 15¢ 
Cc 16¢ 
C 2. ARRAY NAMES APPEAR SINGLY IN DATA STATEMENTS IN THE ROUTINES 176 
C BSPLVN AND COSET. 180 
Cc 19¢ 
C MACHINE DEPENDENT FEATURES...... 206 
Cc 21¢ 
C THIS VERSION OF PDECOL WAS DESIGNED FOR USE ON CDC MACHINES WITH 226 
C A WORD LENGTH OF 6@ BITS. WE DO NOT RECOMMEND THE USE OF PDECOL WITH 236 
C WORD LENGTHS OF LESS THAN 48 BITS. THE MOST IMPORTANT MACHINE 240 
C AND WORD LENGTH DEPENDENT CONSTANTS ARE DEFINED IN THE BLOCK DATA 250 
C AND IN SUBROUTINES COLPNT AND COSET. THE USER SHOULD CHECK THESE 260 
C CAREFULLY FOR APPROPRIATENESS FOR HIS LOCAL SITUATION. THE FORTRAN 270 
C FUNCTIONS USED BY EACH ROUTINE ARE LISTED IN THE COMMENTS TO 286 
C FACILITATE CONVERSION TO DOUBLE PRECISION. 296 
C 300 
(-----------~~--------+-------------~---------+---------.----------------- 310 
(---~+---+--~~-~--~+---~-+~+-----+------ +--+ - +--+ - +--+ +--+ -- --------- 320 
C 330 
(-~------ ~---- nn ne ee +  - - -- -- -- -- == == 340 
C PDECOL IS THE DRIVER ROUTINE FOR A SOPHISTICATED PACKAGE OF 35 
C SUBROUTINES WHICH IS DESIGNED TO SOLVE THE GENERAL SYSTEM OF 360 
C NPDE NONLINEAR PARTIAL DIFFERENTIAL EQUATIONS OF AT MOST SECOND 376 
C ORDER ON THE INTERVAL (XLEFT,XRIGHT) FOR T .GT. T@ WEICH IS OF THE 380 
C FORM.... 390 
Cc 460 
C DU/DT = F(T, X, U, UX, UXX ) 419 
Cc 426 
C WHERE 430 
C 440 
C U = ( U(1), U(2), ... , UCNPDE) ) 450 
Cc UX = ( UX(1), UX(2), ... , UX(NPDE) ) 460 
C UXX = (UXX(1),UXX(2), ... ,UXX(NPDE) ) . 47 
Cc 480 
C EACH U(K) IS A FUNCTION OF THE SCALAR QUANTITIES T AND X. 496 
C UX(K) REPRESENTS THE FIRST PARTIAL DERIVATIVE OF U(K) WITH RESPECT 5060 
C TO THE VARIABLE X, UXX(K) REPRESENTS THE SECOND PARTIAL DERIVATIVE 510 
C OF U(K) WITH RESPECT TO THE VARIABLE X, AND DU/DT IS THE VECTOR OF 520 
C PARTIAL DERIVATIVES OF U WITH RESPECT TO THE TIME VARIABLE T. 530 
C F REPRESENTS AN ARBITRARY VECTOR VALUED FUNCTION WHCSE NPDE 540 
C COMPONENTS DEFINE THE RESPECTIVE PARTIAL DIFFERENTIAL EQUATIONS OF 55¢ 
C THE PDE SYSTEM. SEE SUBROUTINE F DESCRIPTION BELOW. 560 
C 570 
C BOUNDARY CONDITIONS 580 
Cc 590 
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DEPENDING ON THE TYPE OF PDE(S), @, 1, OR 2 BOUNDARY CONDITIONS 
ARE REQUIRED FOR EACH PDE IN THE SYSTEM. THESE ARE IMPOSED AT XLEFT 
AND/OR XRIGHT AND EACH MUST BE OF THE FORM.... 


B(U,UX) = Z(T) 


WHERE B AND Z ARE ARBITRARY VECTOR VALUED FUNCTIONS WITH 

NPDE COMPONENTS AND U, UX, AND T ARE AS ABOVE. THESE BOUNDARY 
CONDITIONS MUST BE CONSISTENT WITH THE INITIAL CONDITIONS WHICH ARE 
DESCRIBED NEXT. 


INITIAL CONDITIONS 


me ee ce ee ee ee ee ee ree ee ee Oe ee es SS A cS 


EACH SOLUTION COMPONENT U(K) IS ASSUMED TO BE A KNOWN (USER 
PROVIDED) FUNCTION OF X AT THE INITIAL TIME T = Td. THE 
INITIAL CONDITION FUNCTIONS MUST BE CONSISTENT WITH THE BOUNDARY 
CONDITIONS ABOVE, I.E. THE INITIAL CONDITION FUNCTIONS MUST 
SATISFY THE BOUNDARY CONDITIONS FOR T = T@. SEE SUBROUTINE UINIT 
DESCRIPTION BELOW. 


REQUIRED USER SUPPLIED SUBROUTINES 


THE USER IS REQUIRED TO CONSTRUCT THREE SUBPROGRAMS AND A MAIN 
PROGRAM WHICH DEFINE THE PDE PROBLEM WHOSE SOLUTION IS TO BE 
ATTEMPTED. THE THREE SUBPROGRAMS ARE... 


1) 


2) 


SUBROUTINE F( T, X, U, UX, UXX, FVAL, NPDE ) 

DIMENSION U(NPDE), UX(NPDE), UXX(NPDE), FVAL(NPDE) 
THIS ROUTINE DEFINES THE DESIRED PARTIAL DIFFERENTIAL 
EQUATIONS TO BE SOLVED. THE PACKAGE PROVIDES VALUES OF THE 
INPUT SCALARS T AND X AND INPUT ARRAYS (LENGTH NPDE) U, UX, 
AND UXX, AND THE USER MUST CONSTRUCT THIS ROUTINE TO COMPUTE 
THE OUTPUT ARRAY FVAL (LENGTH NPDE) WHICH CONTAINS THE 
CORRESPONDING VALUES OF THE RIGHT HAND SIDES OF THE DESIRED 
PARTIAL DIFFERENTIAL EQUATIONS, I.E. 


FVAL(K) = THE VALUE OF THE RIGHT HAND SIDE OF THE K-TH PDE IN 
THE PDE SYSTEM ABOVE, FOR K = 1 TO NPDE. 


THE INCOMING VALUE OF THE SCALAR QUANTITY X WILL BE A 
COLLOCATION POINT VALUE (SEE INITAL AND COLPNT) AND THE 
INCOMING VALUES IN THE ARRAYS U, UX AND UXX CORRESPOND TO THIS 
POINT X AND TIME T. 

RETURN 

END 


SUBROUTINE BNDRY( T, X, U, UX, DBDU, DBDUX, DZDT, NPDE ) 
DIMENSION U(NPDE), UX(NPDE), DZDT(NPDE) . 
DIMENSION DBDU(NPDE,NPDE) , DBDUX(NPDE, NPDE) 
THIS ROUTINE IS USED TO PROVIDE THE PDE PACKAGE WITH NEEDED 
INFORMATION ABOUT THE BOUNDARY CONDITION FUNCTIONS B AND Z 
ABOVE. THE PACKAGE PROVIDES VALUES OF THE INPUT VARIABLES 
T, X, U, AND UX, AND THE USER IS TO DEFINE THE CORRESPONDING 
OUTPUT VALUES OF THE DERIVATIVES OF THE FUNCTIONS B AND Z 
WHERE.... 
DBDU(K,J) = PARTIAL DERIVATIVE OF THE K-TH COMPONENT OF THE 
VECTOR FUNCTION B(U,UX) ABOVE WITH RESPECT TO 
THE J-TH VARIABLE U(J). 
DBDUX(K,J) = PARTIAL DERIVATIVE OF THE K-TH COMPONENT OF THE 
VECTOR FUNCTION B(U,UX) ABOVE WITH RESPECT TO 
THE J-TH VARIABLE UX(J). 
DZDT(K) = DERIVATIVE OF THE K-TH COMPONENT OF THE VECTOR 
FUNCTION Z(T) ABOVE WITH RESPECT TO THE 
VARIABLE T. 


NOTE... THE INCOMING VALUE OF X WILL BE EITHER XLEFT OR XRIGHT. 


IF NO BOUNDARY CONDITION IS DESIRED FOR SAY THE K-TH PDE AT 
ONE OR BOTH OF THE ENDPOINTS XLEFT OR XRIGHT, THEN DBDU(K,K) 
AND DBDUX(K,K) SHOULD BOTH BE SET TO ZERO WHEN BNDRY IS 
CALLED FOR THAT POINT. WE REFER TO THIS AS A NULL BOUNDARY 
CONDITION. THIS ROUTINE CAN BE STRUCTURED AS FOLLOWS... 
THE COMMON BLOCK /ENDPT/ IS NOT A PART OF PDECOL AND 
MUST BE SUPPLIED AND DEFINED BY THE USER. 

COMMON /ENDPT/ XLEFT 

IF( X .NE. XLEFT ) GO TO 10 
HERE DEFINE AND SET PROPER VALUES FOR DBDU(K,J), DBDUX(K,J), 


540-P17- 


0 


COLLECTED ALGORITHMS (cont.) 


AARAAAANRANAANANRANANAANANRAAANANANAAANAAANDA 


MPTAQAAQAAARQRAAAAARAAAARAANAAAARANANANAANANNANMNAaMCaANnANAANAaANnAaAMNANnNAANANAANAMAAAAA 


AND DZDT(K) FOR K,J = 1 TO NPDE FOR THE LEFT BOUNDARY POINT 
X = XLEFT. 

RETURN 

16 CONTINUE 

HERE DEFINE AND SET PROPER VALUES FOR DBDU(K,J), DBDUX(K,J), 
AND DZDT(K) FOR K,J = 1 TO NPDE FOR THE RIGHT BOUNDARY POINT 
X = XRIGHT. 

RETURN 

END 


3) SUBROUTINE UINIT( X, U, NPDE ) 

DIMENSION U(NPDE) 
THIS ROUTINE IS USED TO PROVIDE THE PDE PACKAGE WITH THE 
NEEDED INITIAL CONDITION FUNCTION VALUES. THE PACKAGE 
PROVIDES A VALUE OF THE INPUT VARIABLE X, AND THE USER IS TO 
DEFINE THE PROPER INITIAL VALUES (AT T = T@) FOR ALL OF THE 
PDE COMPONENTS, I.E. 

U(K) = DESIRED INITIAL VALUE OF PDE COMPONENT U(K) AT 
X AND T = TO FOR K = 1 TO NPDE. 

NOTE... THE INCOMING VALUE OF X WILL BE A COLLOCATION POINT 
VALUE. THE INITIAL CONDITIONS AND BOUNDARY CONDITIONS 
MUST BE CONSISTENT (SEE ABOVE). 

RETURN 

END 
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OPTIONAL USER SUPPLIED SUBROUTINE 


IF THE USER DESIRES TO USE THE MF = 11 OR 21 OPTION IN ORDER TO SAVE 
ABOUT 1¢-26 PERCENT IN EXECUTION TIME (SEE BELOW), THEN THE USER MUST 
PROVIDE THE FOLLOWING SUBROUTINE WHICH PROVIDES INFORMATION ABOUT THE 
DERIVATIVES OF THE FUNCTION F ABOVE. THIS PROVIDES FOR MORE EFFICIENT 
JACOBIAN MATRIX GENERATION. ON MOST COMPUTER SYSTEMS, THE USER WILL 
BE REQUIRED TO SUPPLY THIS SUBROUTINE AS A DUMMY SUBROUTINE IF THE 
OPTIONS MF = 12 OR 22 ARE USED (SEE BELOW). 


1) SUBROUTINE DERIVF( T, X, U, UX, UXX, DFDU, DFDUX, DFDUXX, NPDE ) 

DIMENSION U(NPDE), UX(NPDE), UXX(NPDE) 

DIMENSION DFDU(NPDE,NPDE), DFDUX(NPDE,NPDE), DFDUXX(NPDE,NPDE) 
THE PACKAGE PROVIDES VALUES OF THE INPUT VARIABLES T, X, U, UX, 
AND UXX, AND THE USER SHOULD CONSTRUCT THIS ROUTINE TO PROVIDE 
THE FOLLOWING CORRESPONDING VALUES OF THE OUTPUT ARRAYS 
DFDU, DFDUX, AND DFDUXX FOR K,J = 1 TO NPDE... 

DFDU(K,J) = PARTIAL DERIVATIVE OF THE K-TH COMPONENT OF THE 
PDE DEFINING FUNCTION F WITH RESPECT TO THE 
VARIABLE U(J). 
DFDUX(K,J) = PARTIAL DERIVATIVE OF THE K-TH COMPONENT OF THE 
PDE DEFINING FUNCTION F WITH RESPECT TO THE 
VARIABLE UX(J). 
DFDUXX(K,J) = PARTIAL DERIVATIVE OF THE K-TH COMPONENT OF THE 
PDE DEFINING FUNCTION F WITH RESPECT TO THE 
VARIABLE UXX(J). 
NOTE... THE INCOMING VALUE OF xX WILL BE A COLLOCATION POINT 
VALUE. 
RETURN 
END 


USE OF PDECOL 


PDECOL IS CALLED ONCE FOR EACH DESIRED OUTPUT VALUE (TOUT) OF THE 
TIME T, AND IT IN TURN MAKES REPEATED CALLS TO THE CORE INTEGRATOR, 
STIFIB, WHICH ADVANCES THE TIME BY TAKING SINGLE STEPS UNTIL 

T .GE. TOUT. INTERPOLATION TO THE EXACT TIME TOUT IS THEN DONE. 
SEE TOUT BELOW. 


SUMMARY OF SUGGESTED INPUT VALUES 


IT IS OF COURSE IMPOSSIBLE TO SUGGEST INPUT PARAME“ER VALUES WHICH 
ARE APPROPRIATE FOR ALL PROBLEMS. THE FOLLOWING SUGGESTIONS ‘ARE TO 
BE USED ONLY IF YOU HAVE NO IDEA OF BETTER VALUES KOR YOUR PROBLEM. 


DT = 1.E-10 

XBKPT CHOOSE NINT+1 EQUALLY SPACED VALUES SUCH THAT XBKPT(1) = 
XLEFT AND XBKPT(NINT+1) = XRIGHT. 

1L.E-4 


EPS 


136¢ 
137¢ 
1386 
1390 
1400 
141¢ 
1426 
1430 
1440 
1450 
1460 
1470 
148¢ 
1496 
1500 
1510 
1526 
153¢ 
1540 
1550 
1560 
1570 
1580 
1590 
1600 
1610 
1620 
1630 
1646 
1650 
166¢ 
1670 
168¢ 
1696 
1700 
1710 
1726 
173@ 
1740 
175@ 
1760 
1770 
1780 
179¢ 
1800 
1810 
1820 
183¢ 
1840 
185¢ 
1860 
187 
188¢ 
1890 
1960 
1919 
2716 
2720 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
2800 
2810 
2820 
2830 
2840 
2850 
2860 
2870 
2880 
2890 
2900 
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NINT 


KORD 
NCC 
MF 
INDEX 


i} 


THE INPUT 


TO 


TOUT 


DT 


XBKPT 


EPS 


NINT 


KORD 


NCC 


NPDE 


MF 


ENOUGH SO THAT ANY FINE STRUCTURE OF THE PROBLEM MAY BE 
RESOLVED. 

4 

2 

22 

1 (ON FIRST CALL ONLY, THEN @ THEREAFTER). 


PARAMETERS ARE.. 

THE INITIAL VALUE OF T,: THE INDEPENDENT VARIABLE 
(USED ONLY ON FIRST CALL). 

THE VALUE OF T AT WHICH OUTPUT IS DESIRED NEXT. SINCE 
THE PACKAGE CHOOSES ITS OWN TIME STEP SIZES, THE 
INTEGRATION WILL NORMALLY GO SLIGHTLY BEYOND TOUT 
AND THE PACKAGE WILL ‘INTERPOLATE TO T = TOUT. 

THE INITIAL STEP SIZE IN T, IF INDEX = 1, OR, THE 


MAXIMUM STEP SIZE ALLOWED (MUST BE .GT. 6), IF INDEX = 3. 


USED FOR INPUT ONLY WHEN INDEX = 1 OR 3. SEE BELOW. 

THE ARRAY OF PIECEWISE POLYNOMIAL BREAKPOINTS. 
THE NINT+1 VALUES MUST BE STRICTLY INCREASING WITH 
XBKPT(1) = XLEFT AND XBKPT(NINT+1) = XRIGHT (USED ONLY 
ON FIRST CALL). 

THE RELATIVE TIME ERROR BOUND (USED ONLY ON THE 
FIRST CALL, UNLESS INDEX = 4). SINGLE STEP ERROR 
ESTIMATES DIVIDED BY CMAX(I) WILL BE KEPT LESS THAN 
EPS IN ROOT-MEAN-SQUARE NORM. THE VECTOR CMAX OF WEIGHTS 
IS COMPUTED IN PDECOL. INITIALLY CMAX(1) IS SET TO 


ABS(C(I)), WITH A DEFAULT VALUE OF 1 IF ABS(C(I)) .LT. 1. 


THEREAFTER, CMAX(1) IS THE LARGEST VALUE 

OF ABS(C(L)) SEEN SO FAR, OR THE INITIAL CMAX(I) IF 
THAT IS LARGER. TO ALTER EITHER OF THESE, CHANGE THE 
APPROPRIATE STATEMENTS IN THE DO-LOOPS ENDING AT 
STATEMENTS 5@ AND 13@ BELOW. THE USER SHOULD EXERCISE 
SOME DISCRETION IN CHOOSING EPS. IN GENERAL, THE 
OVERALL RUNNING TIME FOR A PROBLEM WILL BE GREATER IF 
EPS IS CHOSEN SMALLER. THERE IS USUALLY LITTLE REASON TO 
CHOOSE EPS MUCH SMALLER THAN THE ERRORS WHICH ARE BEING 
INTRODUCED BY THE USERS CHOICE OF THE POLYNOMIAL SPACE. 
SEE RELATED COMMENTS CONCERNING CMAX BELOW STATEMENT 46. 

THE NUMBER OF SUBINTERVALS INTO WHICH THE SPATIAL DOMAIN 
(XLEFT,XRIGHT) IS TO BE DIVIDED (MUST BE .GE. 1) 

(USED ONLY ON FIRST CALL). 

THE ORDER OF THE PIECEWISE POLYNOMIAL SPACE TO BE USED. 
ITS VALUE MUST BE GRHATER THAN 2 AND LESS THAN 21. FOR 
FIRST ATTEMPTS WE RECOMMEND KORD = 4. IF THE SOLUTION 
IS SMOOTH AND MUCH ACCURACY IS DESIRED, HIGHER VALUES 
MAY PROVE TO BE MORE EFFICIENT. WE HAVE SELDOM USED 
VALUES OF KORD IN EXCESS OF 8 OR 9, THOUGH THEY ARE 
AVAILABLE FOR USE IN PDECOL (USED ONLY ON FIRST CALL). 

THE NUMBER OF CONTINUITY CONDITIONS TO BE IMPOSED ON THE 
APPROXIMATE SOLUTION AT THE BREAKPOINTS IN XBKPT. 

NCC MUST BE GREATER THAN 1 AND LESS THAN KORD. WE 
RECOMMEND THE USE OF NCC = 2 

SINCE THEORY PREDICTS THAT DRAMATICALLY MORE 

ACCURATE RESULTS CAN OFTEN BE OBTAINED USING THIS CHOICE 
(USED ONLY ON FIRST CALL). 

THE NUMBER OF PARTIAL DIFFERENTIAL EQUATIONS IN THE SYSTEM 
TO BE SOLVED (USED ONLY ON FIRST CALL). 

THE METHOD FLAG (USED ONLY ON FIRST CALL, UNLESS 
INDEX = 4). ALLOWED VALUES ARE 11, 12, 21, 22. 

FOR FIRST ATTEMPTS WE RECOMMEND THE USE OF MF = 22. 
MF HAS TWO DECIMAL DIGITS, METH AND MITER 
(MF = 10*METH + MITER). 
METH IS THE BASIC METHOD INDICATOR.. 
METH = 1 MEANS THE ADAMS METHODS (GENERALIZATIONS OF 
CRANK-NICOLSON) . 
METH = 2 MEANS THE BACKWARD DIFFERENTIATION 
FORMULAS -(BDF), OR STIFF METHODS OF GEAR. 
MITER IS THE ITERATION METHOD INDICATOR 
AND DETERMINES HOW THE JACOBIAN MATRIX. IS 
TO BE COMPUTED.. 
MITER = 1 MEANS CHORD METHOD WITH ANALYTIC JACOBIAN. 
FOR THIS USER SUPPLIES SUBROUTINE DERIVF. 
SEE DESCRIPTION ABOVE. 
MITER = 2 MEANS CHORD METHOD WITH JACOBIAN CALCULATED 
INTERNALLY BY FINITE DIFFERENCES. SEE 
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SUBROUTINES PSETIB AND DIFFF. 
INDEX = INTEGER USED ON INPUT TO INDICATE TYPE OF CALL, 
WITH THE FOLLOWING VALUES AND MEANINGS.. 
1 THIS IS THE FIRST CALL FOR THIS PROBLEM. 
i) THIS IS NOT THE FIRST CALL FOR THIS PROBLEM, 
AND INTEGRATION IS TO CONTINUE. 
2 SAME AS @ EXCEPT THAT TOUT IS TO BE HIT 
EXACTLY (NO INTERPOLATION IS DONE). SEE NOTE 
BELOW. ASSUMES TOUT .GE. THE CURRENT T. 
IF TOUT IS .LT. THE CURRENT TIME, THEN TOUT IS 
RESET TO THE CURRENT TIME AND GONTROL IS 
RETURNED TO THE USER. A CALL TO VALUES WILL 
PRODUCE ANSWERS FOR THE NEW VALUE OF TOUT. 
3 SAME AS @ EXCEPT CONTROL RETURNS TO CALLING 
PROGRAM AFTER ONE STEP. TOUT 1S IGNORED AND 
DT MUST BE SET .GT. @ TO A MAXIMUM ALLOWED 
DT VALUE. SEE ABOVE. 
4 THIS IS NOT THE FIRST CALL FOR THE PROBLEM, 
AND THE USER HAS RESET EPS AND/OR MF. 
SINCE THE NORMAL OUTPUT VALUE OF INDEX IS @, 
IT NEED NOT BE RESET FOR NORMAL CONTINUATION. 


NOTE.. THE PACKAGE MUST HAVE TAKEN AT LEAST ONE SUCCESSFUL TIME 
STEP BEFORE A CALL WITH INDEX = 2 OR 4 IS ALLOWED. 

AFTER THE INITIAL CALL, IF A NORMAL RETURN OCCURRED AND A NORMAL 
CONTINUATION IS DESIRED, SIMPLY RESET TOUT AND CALL AGAIN. 

ALL OTHER PARAMETERS WILL BE READY FOR THE NEXT CALL. 

A CHANGE OF PARAMETERS WITH INDEX = 4 CAN BE MADE AFTER 

EITHER A SUCCESSFUL OR AN UNSUCCESSFUL RETURN PROVIDED AT LEAST 
ONE SUCCESSFUL TIME STEP HAS BEEN MADE. 


WORK = FLOATING POINT WORKING ARRAY FOR PDECOL. WE RECOMMEND 
THAT IT BE INITIALIZED TO ZERO BEFORE THE FIRST CALL 
TO PDECOL. ITS TOTAL LENGTH MUST BE AT LEAST 


KORD + 4*NPDE + 9*NPDE**2 + NCPTS*(3*KCRD + 2) + 
NPDE*NCPTS*(34ML + MAXDER + 7) 


WHERE... 
NCPTS = KORD*NINT - NCC*(NINT-1) 
ML = NPDE*(KORD+IQUAD-1) - 1 
IQUAD = 1 IF KORD = 3 AND A NULL BOUNDARY CONDITION EXISTS 
IQUAD = $ OTHERWISE 
MAXDER = 5 UNLESS OTHERWISE SET BY THE USER INTC /OPTION/. 


IWORK = INTEGER WORKING ARRAY FOR PDECOL. THE FIRST TWO 
LOCATIONS MUST BE DEFINED AS FOLLOWS... 
IWORK(1) = LENGTH OF USERS ARRAY WORK 
IWORK(2) = LENGTH OF USERS ARRAY IWORK 
THE TOTAL LENGTH OF IWORK MUST BE AT LEAST 
NCPTS*(NPDE + 1). 
OUTPUT 


THE SOLUTION VALUES ARE NOT RETURNED DIRECTLY TO THE USER BY PDECOL. 
THE METHODS USED IN PDECOL COMPUTE BASIS FUNCTION COEFFICIENTS, SO 
THE USER (AFTER A RETURN FROM PDECOL) MUST CALL THE PACKAGE ROUTINE 
VALUES TO OBTAIN HIS APPROXIMATE SOLUTION VALUES AT ANY DESIRED SPACE 
POINTS X AT THE TIME T = TOUT. SEE THE COMMENTS IN SUBROUTINE VALUES 
FOR DETAILS ON HOW TO PROPERLY MAKE THE CALL. 


EXECUTION ERROR MESSAGES WILL BE PRINTED BY PDECOL ON LOGICAL UNIT 
LOUT WHICH IS THE ONLY VAKIABLE IN THE COMMON BLOCK /IOUNIT/. A 
DEFAULT OF LOUT = 3 IS SET IN THE BLOCK DATA. 


THE COMMON BLOCK /GEAR@¢/ CONTAINS THE VARIABLES DTUSED, NQUSED, 
NSTEP, NFE, AND NJE AND CAN BE ACCESSED EXTERNALLY BY THE USER IF 
DESIRED. RESPECTIVELY, IT CONTAINS THE STEP SIZE LAST USED (SUCCESS- 
FULLY), THE ORDER LAST USED (SUCCESSFULLY), THE NUMBER OF STEPS TAKEN 
SO FAR, THE NUMBER OF RESIDUAL EVALUATIONS (RES CALLS) SO FAR, 

AND THE NUMBER OF MATRIX EVALUATIONS (PSETIB CALLS) SO FAR. 

DIFFUN CALLS ARE COUNTED IN WITH RESIDUAL EVALUATIONS. 


THE OUTPUT PARAMETERS ARE.. 
DT THE STEP SIZE USED LAST, WHETHER SUCCESSFULLY OR NOT. 
TOUT THE OUTPUT VALUE OF T. IF INTEGRATION WAS SUCCESSFUL, 


3670 
3680 
3690 
3700 
3719 
3720 
3730 
3740 
3750 
3760 
3776 
3780 
3790 
38060 
3816 
3820 
3830 
3840 
3850 
3860 
3870 
3880 
3890 
3900 
3910 
3920 
3930 
3940 
3950 
3960 
3970 
3986 
3996 
4600 
4610 
40620 
40630 
4Q4Q 
6110 
612¢ 
6130 
6140 
615¢ 
6160 
6170 
6186 
4070 
4080 
4090 
4100 
4110 
4120 
4130 
4146 
4156 
4160 
4170 
4186 
4190 
4200 
4210 
4220 
4233 
4240 
4250 
4260 
4270 
4286 
4296 
4300 
4316 
4320 
4330 
4340 
4350 
4360 
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INDEX = 


AND THE INPUT VALUE OF INDEX WAS NOT 3, TOUT IS 
UNCHANGED FROM ITS INPUT VALUE. OTHERWISE, TOUT 
IS THE CURRENT VALUE OF T TO WHICH THE INTEGRATION 
HAS BEEN COMPLETED. 

INTEGER USED ON OUTPUT TO INDICATE RESULTS, 
WITH THE FOLLOWING VALUES AND MEANINGS.. 
INTEGRATION WAS COMPLETED TO TOUT OR BEYOND. 
THE INTEGRATION WAS HALTED AFTER FAILING TO PASS THE 
ERROR TEST EVEN AFTER REDUCING DT BY A FACTOR OF 
1.EL@ FROM ITS INITIAL VALUE. 
AFTER SOME INITIAL SUCCESS, THE INTEGRATION WAS 
HALTED EITHER BY REPEATED ERROR TEST FAILURES Ok BY 
A TEST ON EPS. TOO MUCH ACCURACY HAS BEEN REQUESTED. 
THE INTEGRATION WAS HALTED AFTER FAILING TO ACHIEVE 
CORRECTOR CONVERGENCE EVEN AFTER REDUCING DT BY A 
FACTOR OF 1.E1@ FROM ITS INITIAL VALUE. 
SINGULAR MATRIX ENCOUNTERED. PROBABLY DUE TO STORAGE 
OVERWRITES. 
INDEX WAS 4 ON INPUT, BUT THE DESIRED CHANGES OF 
PARAMETERS WERE NOT IMPLEMENTED BECAUSE TOUT 
WAS NOT BEYOND T. INTERPOLATION TO T = TOUT WAS 
PERFORMED AS ON A NORMAL RETURN. TO TRY AGAIN, 
SIMPLY CALL AGAIN WITH INDEX = 4 AND A NEW TOUT. 
ILLEGAL INDEX VALUE. 
ILLEGAL EPS VALUE. 
AN ATTEMPT TO INTEGRATE IN THE WRONG DIRECTION. THE 
SIGN OF DT IS WRONG RELATIVE TO T@ AND TOUT. 
DT .EQ. ¢.0. 
ILLEGAL NINT VALUE. 
ILLEGAL KORD VALUE. 
ILLEGAL NCC VALUE. 
ILLEGAL NPDE VALUE. 
ILLEGAL MF VALUE. 
ILLEGAL BREAKPOINTS -— NOT STRICTLY INCREASING. 
INSUFFICIENT STORAGE FOR WORK OR IWORK. 


SUBROUTINE VALUES (X, USOL,SCTCH,NDIM1,NDIM2,NPTS ,NDERV,WORK) 


i a i a ee ae 


SUBROUTINE VALUES COMPUTES THE SOLUTION U AND THE FIRST NDERV 
DERIVATIVES OF U AT THE NPTS POINTS X AND AT TIME TOUT AND RETURNS 
THEM IN THE ARRAY USOL. THIS ROUTINE MUST BE USED TO OBTAIN 
SOLUTION VALUES SINCE PDECOL DOES NOT RETURN ANY SOLUTION VALUES 
TO THE USER. SEE PDECOL. 


THE CALLING PARAMETERS ARE... 


xX 


USOL 


SCTCH 


NDIM1 


NDIM2 


NPTS 


NDERV 


AN ARBITRARY VECTOR OF SPATIAL POINTS OF LENGTH NPTS AT 
WHICH THE SOLUTION AND THE FIRST NDERV DERIVATIVE VALUES 
ARE TO BE CALCULATED. IF X .LT. XLEFT ( X .GT. XRIGHT ) 
THEN THE PIECEWISE POLYNOMIAL OVER THE LEFTMOST ( RIGHT- 
MOST ) INTERVAL IS EVALUATED TO CALCULATE THE SOLUTION 
VALUES AT THIS UNUSUAL VALUE OF X. SEE PDECOL. 


AN ARRAY WHICH CONTAINS THE SOLUTION AND THE FIRST 
NDERV DERIVATIVES OF THE SOLUTION AT ALL THE POINTS IN 
THE INPUT VECTOR X. IN PARTICULAR, USOL(J,1,K) CONTAINS 
THE VALUE OF THE (K-1)-ST DERIVATIVE OF THE J-TH PDE 
COMPONENT AT THE I-TH POINT OF THE X VECTOR FOR 

J = 1 TO NPDE, I = 1 TO NPTS, AND K = 1 TO NDERV+1. 


A USER SUPPLIED WORKING STORAGE ARRAY OF LENGTH AT LEAST 
KORD* (NDERV+1). SEE BELOW AND PDECOL FOR DEFINITIONS OF 
THESE PARAMETERS. 


THE FIRST DIMENSION OF THE OUTPUT ARRAY USOL IN THE CALLING 


PROGRAM. NDIM1 MUST BE .GE. NPDE. 


THE SECOND DIMENSION OF THE OUTPUT ARRAY USOL IN THE 
CALLING PROGRAM. NDIM2 MUST BE .GE. NPTS. 


THE NUMBER OF POINTS IN THE X VECTOR. 


THE NUMBER OF DERIVATIVE VALUES OF THE SOLUTION THAT ARE 
TO BE CALCULATED. NDERV SHOULD BE LESS THAN KORD SINCE 


4376 
4380 
4396 
4400 
4410 
4420 
4430 
4440 
4450 
4460 
4470 
4480 
4496 
4500 
4516 
4526 
4530 
4546 
4556 
4560 
4570 
4580 
4596 
4600 
4616 
4620 
4630 
4640 
4650 
4660 
4670 
4680 
4690 
4700 
4716 
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THE KORD-TH DERIVATIVE OF A POLYNOMIAL OF DEGREE KORD-1 
IS EQUAL TO ZERO. SEE PDECOL. 


AAAAARAAQAAAANAAN 


AAAANRAAAARANAAAa 


WORK + THE USERS WORKING STORAGE ARRAY WHICH IS USED IN THIS CASE 
TO PROVIDE THE CURRENT BASIS FUNCTION COEFFICIENTS AND THE 
PIECEWISE POLYNOMIAL BREAKPOINT SEQUENCE. 


PACKAGE ROUTINES CALLED.. BSPLVD,INTERV 
USER ROUTINES CALLED.. NONE 


CALLED BY.. 


USERS MAIN PROGRAM 


FORTRAN FUNCTIONS USED.. NONE 


IN THE FOLLOWING DATA STATEMENT, SET.. 


LOUT = THE 
THE 
NOGAUS = SET 
NOT 
MAXDER = SET 
THE 
AGE 


LOGICAL UNIT NUMBER FOR THE OUTPUT OF MESSAGES DURING 
INTEGRATION. 

-EQ. 1 IF THE GAUSS-LEGENDRE COLLOCATION POINTS ARE 
DESIRED WHEN NCC = 2 (SEE PDECOL ANID COLPNT). 

-EQ. 5. ITS VALUE REPRESENTS THE MAXIMUM ORDER OF 
TIME INTEGRATION ALLOWED. ITS VALUE AFFECTS THE STOR- 
REQUIRED IN WORK AND MAY BE CHANGED IF DESIRED 


(SEE COSET FOR RESTRICTIONS). 


UROUND = THE 


UNIT ROUNDOFF OF THE MACHINE, I.E. THE SMALLEST 


POSITIVE U SUCH THAT 1. + U .NE. 1. ON THE MACHINE. 


COMMON /GEAR1/ DUM(5) ,UROUND,IDUM(4) 

COMMON /OPTION/ NOGAUS ,MAXDER 

COMMON /IOUNIT/ LOUT 

DATA LOUT,NOGAUS ,MAXDER, UROUND/3,0,5,7.1E-15/ 


END 
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DESCRIPTION 
1. Introduction 


Computer models of geophysical processes often require the numerical solution 
of elliptic partial differential equations. This is particularly true for models that 
make use of stream functions, velocity potentials, or vorticity equations and for 
models that compute the pressure: of an incompressible fluid. The numerical 
solution of elliptic equations can be a formidable programming task. Moreover, 
the equations are often time dependent, requiring repeated solutions and, hence, 


considerable computing resources. 


Recent advances in computing methods [1, 2] made it possible to solve a very 
large class of elliptic equations (the separable ones) rapidly and with minimal 
storage. And as a result of work on singular problems [6, 8], this class is free of 
special cases for which solutions cannot be obtained numerically. This paper 
describes a package of computer programs that make use of current methods for 
solving elliptic partial differential equations. The package is fully documented 


in [7]. 


We first became involved in implementing the Buneman algorithm [2] and its 
extensions via the capacitance matrix approach [1] for solving Poisson’s equation 
in polar coordinates on a disk. This led directly to two important problems: the 
need to treat the coordinate singularity which occurs at the center of the disk [8] 
and the restriction that the number of unknowns in one coordinate must be a 
power of 2 [10]. It is desirable to relax that restriction for certain studies, since 
geophysicists often work on grids that result in a number of points which are not 
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a power of 2; for example, the commonly used 5° grid results in 72 grid points in 
longitude. 

This work demonstrated that a Poisson equation in any of the usual coordinate 
systems was readily solvable, except on the interior of the sphere. The equation 
for that problem is a special case of the general separable equation (see Section 
2, subroutine S.7) and cannot be solved by the Buneman algorithm. This difficulty 
led to the development of a cyclic reduction algorithm for separable elliptic 
equations [5]. We then wrote two subroutines, POIS and BLKTRI, to implement 
the cyclic reduction and generalized cyclic reduction, respectively. But because 
users were significantly inconvenienced by having to set up the finite-difference 
approximations before using either of these subroutines, the routines were gen- 
erally not well accepted. Hence the National Center for Atmospheric Research 
(NCAR) supported the development of the driver programs S.1 through 8.5 
(listed in Secton 2), which automated the process of generating the finite-differ- 
ence equations for Poisson’s equation in various coordinate systems. After these 
seven subroutines had been developed, we wrote a technical note [7] describing 
their use in detail. The combination of the ease of use of the subroutines and the 
complete documentation substantially increased the usage of the subroutines. 

This experience made it quite apparent that even if a numerical method is 
excellent, the programs will not be widely used unless the software is easy to use 
and the documentation is quite clear. In addition to supporting user convenience, 
our philosophy has been to avoid terminology that might limit the class of users. 
For example, terms such as Dirichlet and Neumann boundary conditions, which 
tend to limit readership, have been replaced with either the solution or the 
derivative of the solution being specified. 

The NCAR technical note [7] contains seven chapters, each describing one of 
the seven Fortran subroutines, and an Appendix dealing with least-squares 
solution of singular linear systems of equations. The first five subroutines solve 
a Helmholtz equation in Cartesian, polar, cylindrical, interior spherical, and 
surface spherical coordinates, respectively. The equations are solved on regular 
domains, namely, on a rectangle in the particular coordinate system that is 
chosen. For example, in polar coordinates the user can select the domain a =r 
< b and c S 6 S d, where a can be zero. The user can also choose any of the 
standard boundary conditions. The solution or its derivative can be specified on 
the boundary, or periodic boundary conditions can be specified. Although these 
programs solve only two-dimensional problems, they can be adapted for use in 
three-dimensional problems by Fourier transforming in the third variable and 
using the parameter in the Helmholtz equation. This procedure is described in 
detail in the technical note [7]. Each chapter also contains a sample Fortran 
program which illustrates the use of the subroutine and provides a check during 
program installation. 

In addition to the description of the Fortran subroutines, the first five chapters 
contain the finite-difference approximations used for the Helmholtz equation and 
the boundary conditions. Any special equations at singular points of the Helm- 
holtz equation (e.g. at the origin, r = 0) are also presented. Approximations of 
second-order accuracy are used throughout. Each of these five chapters contains 
a section entitled “Singular Problems,” which augments the Appendix in describ- 
ing how solutions are obtained in the least-squares sense when a solution does 
not exist in the usual sense. 

Each of these five subroutines calls one of the last two subroutines (POIS and 
BLKTRD), which can be used to solve a more general class of equation. Chapter 
VI describes subroutine POIS, which can be used to solve finite-difference 
approximations to an equation of the form 

2 2 
a(x) - + b(x) = + c(x)u + oe = g(x, y). 
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Chapter VII describes subroutine BLKTRI, which can be used to solve finite- 
difference approximations to the general separable equation 


Fi F) a F) 
a(x) = + B(x) = + c(x)u + d(y) a + e(y) - + fly)u = g(x,y). 


Although BLKTRI can solve problems that POIS solves, POIS is faster. 

Subroutines POIS and BLKTRI use cyclic reduction and generalized cyclic 
reduction, respectively [2, 5, 10], to solve the large sparse linear systems. Although 
some discussion of these methods is included, program descriptions are presented 
separately for those who may wish to use the package only as a computational 
aid. 

In Section 2 of this paper we briefly describe the capabilities of each of the 
seven subroutines; in Section 3 we summarize the various sections in the docu- 
mentation; and in Section 4 we illustrate the documentation by presenting a small 
portion of the NCAR technical note [7]. And finally, in Section 5 we describe the 
modifications that have been made since the initial publication of the package 
and several developments that we are now planning or implementing. 


2. Software Package 


The package consists of seven subroutiness The first five, which are referred to 
as drivers, generate finite-difference approximations to a two-dimensional Helm- 
holtz equation in a particular coordinate system. They are the following. 
S.1 Subroutine PWSCRT solves the Helmholtz equation in Cartesian coordi- 
nates 
vu ou 
ae af PIS) 
on the rectangleasxx=b, csysd. 
S.2 Subroutine PWSPLR solves the Helmholtz equation in polar coordinates 


au 1 du 


on the disk (or sector of the disk) OS axsr=b, OScZ0<d2z. 
S.3 Subroutine PWSCYL solves the modified Helmholtz equation in cylindri- 


cal coordinates 
la ou ,ou ry rime 
—~—{r— —jt+ su=f(r,z 
ror or az? rr’ 


on the slab of the cylinderO=asr=b, csSz<d. 
S.4 Subroutine PWSSSP solves the Helmholtz equation in spherical surface 


coordinates 
af. .o\ 1 #&u 
See eS — + en = 
sin 0 00 (sin t =) sin? 0 ag” eC 


on the sphere (or sector of the sphere) OS as@Sb=2, OS cS od 27. 


S.5 Subroutine PWSCSP solves the modified Helmholtz equation in interior 
spherical coordinates 


Te Oe | ce a a ae ia 
r’ ar or r’sin 0 30 30 r? sin’ 6 ; 
on all or a portion of a cross section of the sphereO =asr=b,0scs60<d 
= 7. 
On each of the boundaries, any of the following conditions can be specified. 
B.1 The solution is specified (Dirichlet condition). 
B.2 The derivative of the solution is specified (Neumann condition). 
B.3 The solution is specified to be periodic. 
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B.4 The solution is unspecified (this condition applies when the domain of the 
equation includes a singularity of the coordinate system, e.g. when solving the 
Helmholtz equation in polar coordinates on the entire disk 0 =r< b, 0O=@S 27). 

Each of the five subroutines performs the following tasks. 

T.1 defines the coefficients in the linear system of equations resulting from the 
finite-difference approximation. 

T.2 incorporates the given boundary data into the right side of the equations. 

T.3 perturbs the right side of the equation when the linear system is singular 
in order to guarantee that a solution exists. 

Once the linear system has been defined, each of the routines calls one of the 
two following subroutines for solving linear systems. 

S.6 Subroutine POIS solves systems resulting from finite-difference approxi- 
mations to equations of the form 

2 2 
a(x) ~ + b(x) = + c(x)u + Aa = f(x, y). 


S.7 Subroutine BLKTRI solves systems resulting from finite-difference ap- 


proximations to general separable elliptic equations of the form 
Pu au au du 
a(x) 3 + W(x) — + e(x)u + d(y) a + e(y) rs + f(y)u = g(x, 9). 


3. Documentation of the Package 


The documentation is completely contained in the NCAR technical note [7]. 
Each of the seven chapters is devoted to one subroutine and contains the 
following sections. 

D.1 Calling Sequence and Parameter List Description. This section gives 
detailed descriptions of the parameters on input and output and information 
likely to be of value to a user deciding whether or not he can use the routine (e.g. 
memory space required, timing, and accuracy). This section will be of primary 
interest to those who wish to use the program strictly as a computational aid. 
This information is also contained on COMMENT cards at the beginning of each 
subroutine. 

D.2 Difference Approximations. This section gives the detailed development 
of the difference approximations used for the equations, for the boundary condi- 
tions, and for the equations at coordinate singularities. 

D.3 Singular Problems. This section gives the exact method used to perturb 
the right side of the equation when the user has specified a problem resulting in 
a singular linear system of equations. 

D.4 Three-Dimensional Problems. This section dernonstrates how to combine 
the use of the Fourier method with the routine in order to solve a Poisson 
equation in three space variables. (It is for this reason that the Helmholtz term 
involving A sometimes has a function multiplying it.) 

D.5 Sample Problem. This section gives a complete description of how to 
define input parameters for a selected differential equation. A Fortran implemen- 
tation of the description is also given and certain cutput variables are given. 
These programs are included in the package as an aid to the user when the 
package is installed at his institution. 

The documentation clearly states the locations of all machine-dependent 
constants used, e.g. 7, and all required library routines, e.g. COS(X). The machine 
precision is required by BLKTRI, but it is computed (approximately) internally. 


4. Sample Documentation 


In this section we reproduce selected parts of the documentation for the routine 
PWSSSP to illustrate the use of the routine and the format of the documentation. 
We shall first state a continuous problem to be solved and then give a Fortran 
program that defines all the necessary input parameters. We then present the 


\ 
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formal parameter list description. Most of the following material is taken verbatim 
from Chapter V of the NCAR technical note [7], although in a different order. 
Assume that we wish to approximate the solution of the Poisson equation 


on the northern hemisphere 0 <= @ <= 


1 a eu 


ou 1 
5 I — | + —_—_ — = —_ oo - 2 
sin 6 30 (sin 0 5) sin? 0 od” 2—6sin* @ sin“ o 


symmetry, i.e. (du/00)(7/2, 6) = 0, OS  S 27. 
The exact solution to this problem is 


u(9, @) = sin? 6 sin” + ¢, 


where c is any constant. Hence, this is a singular problem. 
We choose a 5° grid for our approximation. The Fortran program that defines 
the necessary input parameters for subroutine PWSSSP is given in the first 
program of the listings which follow. 


C 
C 


OOO 


aaa 


aaa aaa 


aqQa 


“1@1 


162 


163 
164 


165 


PROGRAM TO ILLUSTRATE THE USE OF PWSSSP 


DIMENSION F(19, 73) 
1 W(647) 


,BDTF(73)  ,SINT(19) 


THE VALUE OF IDIMF IS THE FIRST DIMENSION OF F. W IS DIMENSIONED 


11% (M+1)+6X (N+1)=647 SINCE M=18 AND N=72 


PI = 3.141592653589793 
INTL = @ 
TS = @ 

TF = PI/2. 
M = 18 
MBDCND = 6 
PS = @ 

PF = PI+PI 
N = 72 
NBDCND = @ 
ELMBDA = @. 
IDIMF = 19 


GENERATE SINES FOR USE IN SUBSEQUENT COMPUTATIONS 


DTHETA = TF/FLOAT(M) 
MP1 = M+1 
DO 1¢1 I=1,MP1 
SINT(L) = SIN(FLOAT(I-1) *DTHETA) 
CONTINUE 
DPHI = (PI+P1I)/FLOAT(N) 
NP1 = N+l 
DO 102 J=1,NP1 
SINP(J) = SIN(FLOAT(J-1)*DPHI) 
CONTINUE 


COMPUTE RIGHT SIDE OF EQUATION AND STORE IN F 


DO 164 J=1,NP1 
DO 103 I=1,MP1 
F(I,J) = 2.-6.*(SINT(I)*SINP (J))**2 
CONTINUE 
CONTINUE 


STORE DERIVATIVE DATA AT THE EQUATOR 
DO 165 J=1,NP1 


BDTF(J) = @. 
CONTINUE 


CALL PWSSSP (INTL,TS,TF,M,MBDCND,BDTS ,BDTF,PS,PF,N,NBDCND,BDPS, 


1 BDPF, ELMBDA, F, IDIMF, PERTRB, IERROR,W) 


COMPUTE DISCRETIZATION ERROR. SINCE PROBLEM IS SINGULAR, THE 


SOLUTION MUST BE NORMALIZED. 


, SINP (73) 


> 


1/2, 0 = @ S 2m, subject to equatorial 


POI@5@42 
POTQ5043 
POIO5O44 
POIG5045 
POIQ5046 
POIQ5047 
POIG5048 
POIG5049 
POI65050@ 
POI@5@51 
POIG5@52 
POI95653 
POIO50654 
POIO5655 
POI@5@56 
POIG50657 
POI@5@58 
POIG50659 
POTG5066¢ 
POI@5@61 
POIG5@62 
POIG5063 
POIG5064 
POI@5065 
POIG5066 
PO165067 
POTG5068 
POIO50669 
POIO5070 
POI@5@71 
POI@5072 
PO1@50673 
POIG5074 
POI@50675 
POIG5076 
POI@50677 
POIG5678 
POI@5079 
POIG548@ 
POI@5@81 
POIG5082 
POI95083 
POI95084 
POI@5085 
POIG5086 
POI@5087 
POIO5G88 
POIG5089 
POIG5690 
POIG5691 
POIG5092 
POIG5093 
POIO5694 
POIG50695 
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Cc POI@50696 
ERR = @ POIG5097 

DO 167 J=1,NP1 POIG5098 

DO 146 I=1,MP1 POLA5699 

Z = ABS(F(I,J)-(SINT(1)*SINP(J))**2-F(1,1)) POIG5100 

IF (Z .GT. ERR) ERR = Z POI65161 

106 CONTINUE POIO51@2 
167 CONTINUE POIG5163 

C POIO5104 
PRINT 1601 , IERROR,ERR,PERTRB POI@5165 

STOP POIO5106 

C POIG5107 
G POIG5168 
C POIG5169 
1901 FORMAT (///9H IERROR= ,13,10X,22H DISCRETIZATION ERR = ,E12.4, POI@5119 
14H PERTURBATION=,E12.4) POI@5111 

C POI@5112 
END POI@5113 


After the CALL to PWSSSP, the discretization error—the maximum absolute 
difference between the exact solution and the finite-difference approximation—is 
computed and printed along with the output parameter PERTRB. The printed 
output is 


TERROR = 0 


DISCRETIZATION ERR = 3.3811E — 03 PERTURBATION = 6.3220E — 04 


The parameters in the call to PWSSSP are defined in the listing which appears 
at the end of this paper. 

Accuracy and Timing. The execution time is proportional to MN logz N and 
is given in Table I for the NCAR Control Data 7600 computer. To test the 
accuracy of the method, a uniform random number generator was used to create 
an array V(I, J), where 0 = V(I, J) = 1. An array F (I, J) was then computed by 
differencing V(I, J) in double precision, using the difference equations that 
correspond to the sample problem. With F(I, J) as a right side, subroutine 
PWSSSP was used to compute a solution U(I, J). The maximum absolute 
difference between U(1I, J) and V(I, J) is given in Table I. These errors can be 
compared with the accuracy of the NCAR 7600 (107 '*) to give a measure of the 
loss of significant digits due to roundoff. This error should not be confused with 
the discretization error given after the sample Fortran program. 


5. Concluding Remarks 


This package is not static, but is currently undergoing modifications to improve 
the solution techniques and extend the range of problems that can be solved. The 
following additions and modifications have already been made. 

(1) Currently available is a subroutine, SEPELI, which discretizes the general 
separable elliptic equation. Thus the process of differencing the equations, incor- 
porating the boundary conditions, and solving the resulting equations is auto- 
mated as in the driver programs described in Section 2. Also included in this 
program is the option of obtaining fourth-order accurate solutions via the method 
of deferred corrections [3]. As in the other drivers, a weighted least-squares 
solution is obtained if that solution does not exist in the usual sense. More 


Table I 
M N Execution time Maximum absolute 
(ms) difference 
8 32 14 2.3 x 10° 
16 64 60 1.3 x 10°" 
32 128 248 7.7x 10° 


Note: If NBDCND # 0, the execution times can be halved. 
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information may be obtained from John Adams, who has developed this program 
at NCAR. 

(2) Replacements for the subroutines POIS and BLKTRI have been developed 
and tested and are in their final stage of documentation. The earlier versions of 
POIS and BLKTRI impose restrictions on the block order of the linear system of 
equations. The new algorithms eliminate this restriction. They also reduce to the 
efficient cyclic reduction algorithms when N = 2”. The new algorithm for POIS 
is given in [9]. 

(3) With the use of this new algorithm, a subroutine, POISTG, has been 
developed [4] to solve finite-difference approximations to Helmholtz equations 
defined on staggered grids. This routine has been written in the format of POIS 
and BLKTRI. Drivers such as those described in Section 2 are now being written 
to solve finite-difference approximations to modified Helmholtz equations defined 
on a staggered grid. 

In the early planning stage is a subroutine that will solve the general nonse- 
parable linear elliptic equation in which the coefficients depend on both inde- 
pendent variables. However, it is anticipated that this program will use iterative 
rather than direct methods. 

We feel that this package of high-quality, reliable, efficient programs for the 
solution of finite-difference approximations to elliptic equations is a significant 
step in the development of a complete package designed to solve an extremely 
wide class of elliptic partial differential equations. 


Notre ADDED IN PRooF. In the period since this paper was submitted for 
publication, all of the subroutines listed in modifications (1)-(3) above have been 
implemented in the latest version of the package. In addition, a driver for solving 
a three-dimensional Helmholtz equation in Cartesian coordinates, its associated 
solver, and two fast Fourier transform packages have been implemented. The 
interested reader should contact one of the authors at NCAR. 
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[Summary information and a part of the listing is printed here. The complete 
listing is available from the ACM Algorithms Distribution Service. ] 
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NAME(n): indicates a Fortran module with n records 
NAME'(n): indicates “NAME” is included for testing purposes 
Contents: PWSCRT(416), PWSPLR(512), PWSCYL(455), PWSSSP(313), 
PWSSS1(356), PWSCSP(340), PWSCS1(247), POIS(153), 
POISGN (411), POINIT(136), TRID(43), TPIDP(63), 
BLKTRI(200), BLKTRI(132), PROD (90), PRODP(107), 
CPROD(103), CPRODP(125), PPADD(119), PSGF(12), 
BSRH(17), PPSGF(9), PPSPF(9), COMPB(98), TQLRAT(162), 
NCHECK (29), APEXPS(9), STORE(S), MAIN1"(101), 
MAIN2™(101), MAIN3™(114), MAIN4™(95), MAIN5‘(140), 
MAIN6"(110), MAIN7'(117) 
SUBROUTINE PWSSSP (INTL,TS,TF,M,MBDCND,BDTS,BDTF,PS,PF,N,NBDCND, POI@1387 
1 BDPS, BDPF, ELMBDA, F, IDIMF, PERTRB, ILERROR,W) POIG1388 
C POIG1389 
Cc SUBROUTINE PWSSSP SOLVES A FINITE DIFFERENCE APPROXIMATION TO THE POI@1414 
Cc HELMHOLTZ EQUATION IN SPHERICAL COORDINATES AND ON THE SURFACE OF POI@1415 
C THE UNIT SPHERE (RADIUS OF 1): POIQ@1416 
c POI@1417 
Cc (1/SIN (THETA) ) (D/DTHETA) (SIN(THETA) (D/DTAETA)U) POI@1418 
Cc POIG1419 
C + (1/SIN(THETA)**2) (D/DPHI) (D/DPHI)U POIG1426 
Cc POIA1421 
C + LAMBDA*U = F(THETA, PHI) POI@1422 
Cc POI61423 
Cc WHERE THETA IS COLATITUDE AND PHI IS LONGITUDE. POI@1424 
C POI@1425 
6 THE ARGUMENTS ARE DEFINED AS: POIG1426 
C POI@1427 
C POIG1428 
Cc KKK KKK RK KKK ON INPUT kK RK RK KR KR RK KKK POI@1429 
Cc POIG1430 
Cc INTL POI@1431 
C = @ ON INITIAL ENTRY TO PWSSSP OR IF N,NBDCND,PS OR PF ARE POIG@1432 
¢ CHANGED FROM A PREVIOUS CALL POIG1433 
c = 1 IF PS,PF,N AND NBDCND ARE UNCHANGED FROM A PREVIOUS CALL POI@1434 
Cc POIG1435 
Cc NOTE: A CALL WITH INTL = 1 IS ABOUT 1 PERCENT FASTER THAN A POI@1436 
C CALL WITH INTL = @ POIG1437 
Cc POIG1438 
G TS,TF POI@1439 
Cc THE RANGE OF THETA (COLATITUDE), I.E., TS .LE. THETA .LE. TF. POI@144@ 
Cc TS MUST BE LESS THAN TF. TS AND TF ARE IN RADIANS. A TS OF POIQ@1441 
c ZERO CORRESPONDS TO THE NORTH POLE AND A TF OF PI CORRESPONDS TOPOI@1442 
C THE SOUTH POLE. POI@1443 
C POIG1444 
C M POI@1445 
Cc THE NUMBER OF PANELS INTO WHICH THE INTERVAL (TS,TF) IS POI@1446 
Cc SUBDIVIDED. HENCE, THERE WILL BE M+l GRID POINTS IN THE POIG1447 
@ THETA-DIRECTION GIVEN BY THETA(I) = (I-1)DTHETA+TS FOR POIG1448 
Cc I = 1,2,...,M+1, WHERE DTHETA = (TF-TS)/M IS THE PANEL WIDTH. POI@1449 
6 POI@145¢ 
Cc MBDCND POI@1451 
Cc INDICATES THE TYPE OF BOUNDARY CONDITION AT THETA = TS AND POIG1452 
Cc THETA = TF. POIG1453 
C POI@1454 
C = 1 IF THE SOLUTION IS SPECIFIED AT THETA = TS AND THETA = TF. POI@1455 
C = 2 IF THE SOLUTION IS SPECIFIED AT THETA = TS AND THE POIG1456 
C DERIVATIVE OF THE SOLUTION WITH RESPECT TO THETA IS POI@1457 
C SPECIFIED AT THETA = TF (SEE NOTE 2 BELOW). POIG1458 
Cc = 3 IF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO THETA IS POI@1459 
C SPECIFIED AT THETA = TS AND THETA = TF (SEE NOTES 1,2 POIG1460 
Cc BELOW). POI@1461 
C = 4 IF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO THETA IS POI@1462 
C SPECIFIED AT THETA = TS (SEE NOTE 1 BELOW) AND THE POIG1463 
Cc SOLUTION IS SPECIFIED AT THETA = TF. POI@1464 
Cc = 5 IF THE SOLUTION IS UNSPECIFIED AT THETA = TS = @ AND THE POI@1465 
C SOLUTION IS SPECIFIED AT THETA = TF. PO101466 
C = 6 IF THE SOLUTION IS UNSPECIFIED AT THETA = TS = @ AND THE POI@1467 
c DERIVATIVE OF THE SOLUTION WITH RESPECT TO THETA IS POI@1468 
C SPECIFIED AT THETA = TF (SEE NOTE 2 BELOW). PO1IG1469 
C = 7 IF THE SOLUTION IS SPECIFIED AT THETA = TS AND THE POIG1470 
C SOLUTION IS UNSPECIFIED AT THETA = TF = PI. POI@1471 
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AAANMQAARAAAARAAANAANANAAANNANNAAMAANAANANANAMAAAMAAMAAMAANAANAAMAANMNANNAANNANANNNAMAANMNANAANANANAnNAAAnAAAAAA 


SPECIFI 
SOLUTIO 
IF THE 
THETA = 


NOTES: 1. 


BDTS 


A ONE-DIMENSIONAL ARRAY OF LENGTH N+1 THAT SPECIFIES THE VALUES 


2. 


ED AT THETA = TS (SEE NOTE 1 BELOW) AND THE 

N IS UNSPECIFIED AT THETA = TF = PI. 
SOLUTION IS UNSPECIFIED AT THETA = TS = 
TF = Pl. 


@ AND 


IF TS = @, DO NOT USE MBDCND = 3,4, OR 8, BUT 
INSTEAD USE MBDCND = 5,6, OR 9 
IF TF = PI, DO NOT USE MBDCND = 2,3, OR 6, BUT 
INSTEAD USE MBDCND = 7,8, OR 9 


OF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO THETA AT 


THETA = 


TS. 


BDTS (J) 


WHEN MBDCND = 3,4, OR 8, 


= (D/DTHETA)U(TS,PHI(J)), J = 1,2,...,Ntl . 


WHEN MBDCND HAS ANY OTHER VALUE, BDTS IS A DUMMY VARIABLE. 


BDTF 


A ONE-DIMENSIONAL ARRAY OF LENGTH N+1 THAT SPECIFIES THE VALUES 


OF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO THETA AT 


THETA = 


TF. 


BDTF (J) 


WHEN MBDCND = 2,3, OR 6, 


= (D/DTHETA)U(TF,PHI(J)), J = 1,2,...,N+1 


WHEN MBDCND HAS ANY OTHER VALUE, BDTF IS A DUMMY VARIABLE. 


PS,PF 


THE RANGE OF PHI (LONGITUDE), I.E., PS .LE. PHI .LE. PF. 


MUST 


N 


BE LESS 


PS 


THAN PF. PS AND PF ARE IN RADIANS. IF PS = 


THE NUMBER OF PANELS INTO WHICH THE INTERVAL (PS,PF) IS 


SUBDI 


VIDED. 


HENCE, THERE WILL BE N+l1 GRID POINTS IN THE 


PHI-~DIRECTION GIVEN BY PHI(J) = (J-1)DPHI+PS FOR 


J = 


1,2,...,N+1, WHERE DPHI = (PF-PS)/N IS THE PANEL WIDTH. 


@ AND 
PF = 2*PI, PERIODIC BOUNDARY CONDITIONS ARE USUALLY PRESCRIBED. 


N 


8 IF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO THETA IS POI@1472 


POI@1473 
POIG1474 
POI@1475 
POI@1476 
POI@1477 
POI@1478 
POI@1479 
POIG1480 
POI@1481 
POI@1482 
POI@1483 
POT@1484 
POI@1485 
POIO1486 
POIG1487 
POI@1488 
POI@1489 
POIG149¢0 
POI@1491 
POI@1492 
POI01493 
POIG1494 
POT@1495 
POI@1496 
POI@¢1497 
POI@1498 
POIG1499 
POIG1500 
POI@1561 
POI@1562 
POIG1563 
POIG1504 
POI@15065 
POI@1506 
POI@1507 
POIO1568 
POIG15909 
POIG1510 


MUST BE OF THE FORM (2**P) (3**Q) (5**R) WHERE P, Q, AND R ARE ANYPOI@1511 


NON-NEGATIVE INTEGERS. 


NBDCND 


INDICATES THE TYPE OF BOUNDARY CONDITION AT PHI = 


PHI = 


W 
Se 


NOTE: 


BDPS 


A ONE-DIMENSIONAL ARRAY OF LENGTH Mtl THAT SPECIFIES THE VALUES 


PF. 


IF THE 
U(I,1) 
IF THE 
(SEE NO 
IF THE 


AND THE DERIVATIVE 


SPECIFI 


N MUST BE GREATER THAN 2 


PS AND 


SOLUTION IS PERIODIC IN PHI, I.E., 
= U(I,N+1). 
SOLUTION IS SPECIFIED AT PHI = PS AND PHI = PF 


TE BELOW). 
SOLUTION IS SPECIFIED AT PHI = PS (SEE NOTE BELO 
OF THE SOLUTION WITH RESPECT TO PHI 


ED AT PHI = PF. 


W) 
IS 


IF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO PHI IS 


SPECIFI 


ED AT PHI = PS AND PHI = PF. 


IF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO PHI IS 


SPECIFI 
(SEE NO 


NBDCN 
MBDCN 


MBDCN 


ED AT PS AND THE SOLUTION IS SPECIFIED AT PHI = 


TE BELOW). 

D = 1,2, OR 4 CANNOT BE USED WITH 

D = 5,6,7,8, OR 9 (THE FORMER INDICATES THAT THE 
SOLUTION IS SPECIFIED AT A POLE, THE LATTER 
INDICATES THAT THE SOLUTION IS UNSPECIFIED). 
USE INSTEAD 

D=10R2 . 


OF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO PHI AT 


PHI = 


PS. 


BDPS (I) 


WHEN NBDCND = 3 OR 4, 


= (D/DPHI)U(THETA(I),PS), I = 1,2,...,M+1 


WHEN NBDCND HAS ANY OTHER VALUE, BDPS IS A DUMMY VARIABLE. 


BDPF 


A ONE-DIMENSIONAL ARRAY OF LENGTH M+1 THAT SPECIFIES THE VALUES 


PF 


POI@1512 
POI@1513 
POI@1514 
POI@1515 
POI@1516 
POI@1517 
POI@1518 
POI@1519 
POIG152¢ 
POI@1521 
POI@1522 
POIG1523 
POI@1524 
POI@1525 
POIG1526 
POI@1527 
POIG1528 
POI@1529 
POIG153@ 
POI@1531 
POI@1532 
POI@1533 
POI@1534 
POI@1535 
POIG1536 
POI@1537 
POI@1538 
POI@1539 
POIG1546 
POI@1541 
POI@1542 
POIG1543 
POI@1L544 
POI@1545 
POI@1546 
POIG1547 
POIG1548 
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AQAQAIGAIIAAAIAQAAAAAANAAAARNAANAAAAAANANRANAANAANANAAMAANANAAANAAANAANAANAAAANNAAANKMNAAAAA AN GO 


OF THE DERIVATIVE OF THE SOLUTION WITH RESPECT TO PHI AT 
WHEN NBDCND = 2 OR 3, 


PHI = PF. 


BDPF(I) = (D/DPHI)U(THETA(L),PF), I = 1,2,... 


WHEN NBDCND HAS ANY OTHER VALUE, BDPF IS A DUMMY VARIABLE. 


ELMBDA 


THE CONSTANT LAMBDA IN THE HELMHOLTZ EQUATION. 
LAMBDA .GT. @, A SOLUTION MAY NOT EXIST. 
ATTEMPT TO FIND A SOLUTION. 


F 


A TWO-DIMENSIONAL ARRAY THAT SPECIFIES THE VALUE OF THE RIGHT 
SIDE OF THE HELMHOLTZ EQUATION AND BOUNDARY VALUES (IF ANY). 
FOR I = 2,3,.. 


.»M AND J = 2,3,...,N 


F(I,J) = F(THETA(L),PHI(J)). 


ON THE BOUNDARIES F IS DEFINED BY 


MBDCND 


CONKDUBWNHE 


NBDCND 


F(1,J) 


U(TS, PHI (J)) 
U(TS,PHI(J)) 
F(TS,PHI(J)) 
F(TS,PHI(J)) 
F(@,PS) 
F(@,PS) 
U(TS,PHI(J)) 
F(TS,PHI(J)) 
F(@,PS) 


F(THETA(I) ,PS) 
U (THETA (I) ,PS) 
U(THETA(T) ,PS) 
F (THETA(T) ,PS) 
F (THETA(TI) ,PS) 


F(M+1, J) 


U(TF, PHI(J)) 
F(TF,PHI(J)) 
F(TF,PHI(J)) 
UC(TF,PHI(J)) 
U(TF,PHI(J)) 
F(TF,PHI(J)) 
F(PI,PS) 
F(PI,PS) 
F(PI,PS) 


F(I,N+1) 


F(THETA(I),PS) 
U(THETA(1) ,PF) 
F(THETA(I) ,PF) 
F(THETA(I) ,PF) 
U(THETA(L) ,PF) 


F MUST BE DIMENSIONED AT LEAST (M+1)*(N+1). 


NOTE 


IF 


I 


M+ 


HOWEVER, PWSSSP WILL 


= 1,2,.. 


POI@1549 
POI@1550 
POI@1551 
POI@1552 
POI@1553 
POI@1554 
POI@1555 
POI@1556 
POI@1557 
POI@1558 
POI@1559 
POI@156¢@ 
POI@1561 
POIO1562 
POI@1563 
POIG1564 
POI@1565 
POIG1566 
POIO1567 
POT@1568 
POI@1569 
POI@157@ 
POI@1571 
POI@1572 
POI@1573 
POI@1574 
POI@1575 
POI@1576 
POIO1577 
POI@1578 
POIO1579 
POIG1580 
POI@1581 
POI@1582 
POI61583 
POI91584 
POI@1585 
POIG1586 
POI@1587 
. M+1P01@1588 

POIG1589 

POIG159¢6 

POI@1591 

POIG1592 

POL@1593 

POI@1594 

POI@1595 


IF THE TABLE CALLS FOR BOTH THE SOLUTION U AND THE RIGHT SIDE F PO1I@1596 
AT A CORNER THEN THE SOLUTION MUST BE SPECIFIED. 


IDIMF 


POIG1597 
POIO1598 
POI61599 


THE ROW (OR FIRST) DIMENSION OF THE ARRAY F AS IT APPEARS IN THEPOIG16606 


PROGRAM CALLING PWSSSP. 


VARIABLE DIMENSION OF F. 


W 


A ONE-DIMENSIONAL ARRAY THAT MUST BE PROVIDED BY THE USER FOR 
THE LENGTH OF W MUST BE AT LEAST 11(M+1)+6(Nt1). 


WORK SPACE. 


KKK KKK KK KKH 


F 


ON OUTPUT 


RREK KKK K KEK 


CONTAINS THE SOLUTION U(I,J) OF THE FINITE DIFFERENCE 
APPROXIMATION FOR THE GRID POINT (THETA(I),PHI(J)), 


I= 1,2,...,M+tl, 


PERTRB 


IF ONE SPECIFIES A COMBINATION OF PERIODIC, DERIVATIVE OR 


J=1,2,...,Ntl . 


UNSPECIFIED BOUNDARY CONDITIONS FOR A POISSON EQUATION 


(LAMBDA = @), A SOLUTION MAY NOT EXIST. 


PERTRB IS A CONSTANT, 


THIS PARAMETER IS USED TO SPECIFY THE POI@16¢1 
IDIMF MUST BE AT LEAST Mtl 


POIG1662 
POIO1603 
POTG1604 
POIG16065 
POIO1606 
POI@1607 
POIG16468 
POIG1609 
POIG1610 
POI@1611 
POI@1612 
POI@1613 
POI@1614 
POI@1615 
POI@1616 
POI@1617 
POIG1618 
POIG1619 


CALCULATED AND SUBTRACTED FROM F, WHICH ENSURES THAT A SOLUTION POI@162¢ 


EXISTS. 


SQUARES SOLUTION TO THE ORIGINAL APPROXIMATION. 
IS NOT UNIQUE AND IS UNNORMALIZED. THE VALUE OF PERTRB SHOULD 
BE SMALL COMPARED TO THE RIGHT SIDE F. OTHERWISE 


PWSSSP THEN COMPUTES THIS SOLUTION, WHICH IS A LEAST 
THIS SOLUTION 


A SOLUTION 


POIG1621 
POI61622 
POIG61623 
POIO1624 


IS OBTAINED TO AN ESSENTIALLY DIFFERENT PROBLEM. THIS COMPARISONPOI@1625 


541-P10- 


0 


COLLECTED ALGORITHMS (cont.) 


C SHOULD ALWAYS BE MADE TO INSURE THAT A MEANINGFUL SOLUTION HAS PO1I@1626 
C BEEN OBTAINED POI@1627 
Cc POIG1628 
Cc LERROR POIG1629 
Cc AN ERROR FLAG THAT INDICATES INVALID INPUT PARAMETERS. EXCEPT POI@1630 
C FOR NUMBERS @ AND 8, A SOLUTION IS NOT ATTEMPTED. POI@1631 
Cc POI@1632 
Cc = ¢ NO ERROR. POI@1633 
Cc = 1 TS .LT. @ OR TF .GT. PI POIG1634 
Cc = 2 TS .GE. TF. POI@1635 
c = 3 MBDCND .LT. 1 OR MBDCND .GT. 9 POI@1636 
Cc = 4 PS .GE. PF. POI@1637 
Cc = 5 N IS NOT OF THE FORM (2**P) (3**Q) (5**R) OR N .LE. 2 POIG1638 
C = 6 NBDCND .LT. # OR NBDCND .GT. 4 . POI@1639 
C = 7 AN NBDCND OF 1,2, OR 4 IS USED WITH AN POIQ1640 
C MBDCND OF 5,6,7,8, OR 9 POI@1641 
C = 8 ELMBDA .GT. @ . POI@1642 
c = 9 IDIMF .LT. Mtl POIG1643 
C = 1¢ TS=¢ AND MBDCND=3,4 OR 8 OR TF=PI AND MBDCND=2,3 OR 6 POI@1644 
Cc POI@1645 
Cc SINCE THIS IS THE ONLY MEANS OF INDICATING A POSSIBLY INCORRECT POI@1646 
Cc CALL TO PWSSSP, THE USER SHOULD TEST IERROR AFTER A CALL. POI@1647 
@ POIG1648 
C W POIG1649 
€ CONTAINS INTERMEDIATE VALUES THAT MUST NOT BE DESTROYED IF POIG1650 
c PWSSSP WILL BE CALLED AGAIN WITH INTL = 1 POI@1651 
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Efficient Fortran Subprograms for the Solution of Separable Elliptic Partial 
Differential Equations [D3] 

[P.N. Swarztrauber and R.A. Sweet, ACM Trans. Math. Software 5, 3 (September 
1979), 352-364. ] 


Michael Steuerwalt [Recd 10 Feb. 1977 and 31 Jan. 1979] 
Los Alamos Scientific Laboratory, P.O. Box 1663, Los Alamos, NM 87545 


INTRODUCTION 


The problem of computing solutions to modified Helmholtz equations (or, more 
generally, separable linear elliptic equations) with simple boundary conditions on 
a rectangle in any of several coordinate frames arises frequently in applications 
and as an intermediate step in the solution of nonlinear and evolution problems. 
The cost of developing, documenting, and testing a package for this task is not 
negligible. Therefore several federal laboratories that can profitably use the 
National Center for Atmospheric Research (NCAR) package [2] chose to collab- 
orate in its certification. 


THE PACKAGE 


Physically, the NCAR package consists of about 4700 lines of Fortran code 
(almost 40 percent are comments), 800 lines of example drivers, and 140 pages of 
documentation. The package cost about $300,000 to develop. In comparison, 
EISPACK has 11,500 lines of code (49 percent are comments), 10,000 lines of 
example drivers, 551 pages of documentation [1], and cost about $900,000. 

The heart of the NCAR package is the two routines POIS and BLKTRI, which 
solve the linear systems arising from standard second-order finite-difference 
approximations of separable elliptic boundary value problems on rectangles. The 
package also includes five drivers that build the discrete system from the least 
possible information: the differential equation and boundary conditions, the 
geometric region, and the number of (evenly spaced) mesh points in each 
direction. Most users will communicate with the core routines only through these 
drivers. 
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THE CERTIFICATION EFFORT 


Each of the five laboratories that had agreed to collaborate in the certification 
effort assumed responsibility for a particular driver: 

PWSCRT: Air Force Weapons Laboratory, Kirtland Air Force Base, Albu- 

querque, N. Mex. 

PWSPLR: Lawrence Livermore Laboratory, Livermore, Calif. 

PWSCYL: Sandia Laboratories, Livermore, Calif. 

PWSCSP: Sandia Laboratories, Albuquerque, N. Mex. 

PWSSSP: Los Alamos Scientific Laboratory, Los Alamos, N. Mex. 

Each laboratory agreed to 

(a) Compile the entire package. 

(b) Verify the results of the seven NCAR example programs. 

(c) Verify the correct working of the input error detection code. 

(d) For its particular driver, run a test problem using 

(1) several permissible regions, 

(2) several mesh sizes in each direction, 
(3) all possible boundary conditions, 

(4) zero and nonzero values of A. 

(e) Evaluate the documentation. 

It is important to note what we did not try to do: 

(a) Explicitly test the core routines POIS and BLKTRI. Access to these 
routines was through the drivers alone. 

(b) Make efficiency tests. The methods of the core routines are among the 
best direct methods available, but neither the authors nor the certifiers claim 
that there are no methods more efficient. In particular, we expect that higher- 
order discretization schemes would be more efficient for a given (small enough) 
accuracy. 

(c) Make severe tests of the package’s robustness. 

The schedule outlined above entails a considerable effort. Among the five 
laboratories there are perhaps 10 different Fortran compilers, so the simple 
compilation of the package is a good test of its portability. The testing implied by 
(d) is substantial. For example, the driver PWSSSF admits 9 different possible 
boundary conditions in the @ direction and 5 in the ¢ direction; not all combina- 
tions are compatible, and some are valid only for certain geometries. To complete 
part (d) for the PWSSSP routine, 8 different regions were used with all possible 
valid boundary conditions, and with 5 different mesh sizes in the @ direction and 
4 in the ¢ direction, for a total of 2360 runs per value of A. Testing of the other 
drivers was similar. See the Appendix for details of the test problems. 


RESULTS OF THE CERTIFICATION EFFORT 


After initial tests, the certification team suggested several changes in the package 
and the documentation. All our recommendations were adopted. The most 
significant of these changes are the following. 

(1) Version numbers for the package. The version we are certifying here is 
Version 2. 

(2) Correction of initialization errors. The core routines POIS and BLKTRI 
perform some preliminary computations that neecl not be repeated if certain 
problem parameters remain unchanged. Our first tests had revealed program 
errors that could be avoided only by reinitializing every problem. 

(3) Additional code to check for illegal combinations of problem parameters. 
The documentation clearly indicates that certain choices of boundary conditions 
are incompatible with particular geometries. For instance, in PWSSSP, three 
possible choices of the boundary condition at the final value TF of @ require that 
TF = 7. A sample problem was run with these choices of boundary condition but 
with TF < 7. The package did not check for such illegal combinations, but simply 
computed, producing wrong answers. In Version 2, the drivers will also set an 
error flag if, say, | TF — 7| is “too large.” We feel that the package’s robustness 
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is well enhanced by including this check, which has been done in a portable way 
and at little computing expense. On the other hand, we should remark that 
Swarztrauber and Sweet have indicated to us some uneasiness regarding the 
introduction of the imprecise and machine-dependent notion of “too large,” and 
that no package, whatever its robustness or quality of documentation may be, 
can protect a user bent on self-immolation. 

(4) An extensive list of errata and changes to the documentation. The docu- 
mentation is neither so exhaustive as the EISPACK guide nor so rich in examples 
of the routines’ use. This is no handicap: use of the NCAR routines is straight- 
forward, whereas EISPACK often provides several options for doing a computa- 
tion. 

All the program tests were repeated for Version 2 to verify the corrections. The 
tests show that the methods are indeed of second-order accuracy. We deem the 
package to be valuable software of good quality. We especially commend its 
design, which permits users to communicate with it in familiar terms so that they 
do not have to grasp the mechanics of the discretization procedure. We believe 
the documentation will help that user who only wants answers to his problems to 
get those answers while remaining in blissful ignorance of details peripheral to 
his interests. 


APPENDIX. DETAILS OF THE TEST PROBLEMS 


Each driver may distinguish types of regions according to the geometry of the 
problem. Some combinations of boundary conditions and regions are not admis- 
sible. In this Appendix we tabulate the valid combinations for each driver; the 
entry “—” indicates no legal combination. We also list the intervals whose 
Cartesian products form the regions used in the certification tests, and give the 
true solution uw of the various boundary value problems. The appropriate bound- 
ary values and the function f can be determined for a given problem from uy, 4, 
and the region. For all problems the values of A, M, and N used were 


Ke 0.0 —1.0 
M : 9 18 36 72 144 
N : 15 30 45 60 


PWSCRT 


All 25 possible combinations of MBDCND and NBDCND are valid. The two 
regions used were 


[A, B] = [— 1/2, 1/2] 
[C, D] = [— 1/2, 1/2] [0, 2]. 
The true solution was 
u = sin 27(x + 1/8) cos 27(y + 1/8). 
PWSPLR 


This driver distinguishes two types of regions: 


0<A Pp 
O=A Z 
The compatibility table has 34 entries: 
NBDCND 
MBDCND 0 1 2 3 4 


PZ PZ PZ PZ PZ 
PZ PZ PZ PZ PZ 
P. P P P P 
P P P id P 
Z — — Z 
Z Z 


aOR WN = 
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The four regions used were 
[A, B] = [1/4, 1] [0, 1] 
[C, D] =[0, 27/3] — [2a, 81/3}. 
The true solution was 


u =r cos(476/[D — C] + 7/4). 


PWSCYL 
This driver distinguishes two types of regions: 
O<A P 
O=A Z 
The compatibility table has 40 entries: 
NBDCND 
MBDCND 0 1 2 #3 4 
1 PZ PZ PZ PZ PZ 
2 PZ PZ PZ PZ PZ 
3 P P P P P 
4 P P P P P 
5 Z Z Z Z Z 
6 Z Z Z Z Z 


The two regions used were: 
[A, B] = (1, 2] [0, 1] 
[C, D] = [0, 27]. 

The true solution was 


u = r’cos(z + 17/4). 


PWSCSP 
This driver recognizes eight types of regions: 
0<RS 0=RS 


0<TS,TF<7 A 1) 

0=TS, TF <7 B F 

0< TS, TF=7 C G 

0 = TS, TF = 7 D ie 

The compatibility table has 72 entries: 
NBDCND 

MBDCND - 1 2 3 4 5 6 
1 ABCD ABCD ABCD ABCD — — 
2 AB AB AB AB — — 
3 A A A A E E 
4 AC AC AC AC — — 
5 BD BD BD BD — — 
6 B B B B F F 
7 CD CD CD CD — — 
8 C C C C G G 
9 D D D D H H 


The eight regions used were 


[TS,TF] =[7/4, 7/2] [0,7/2] = [2/2,7] — [0, a] 
[RS, RF] =[1, 2] (0, 1]. 


The true solution was 


u =r'cos' 6. 
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PWSSSP 
This driver distinguishes four types of regions: 
0< TS, TF <7 A 
0= TS, TF <7 B 
0< TS, TF=7 C 
0= TS, TF =7 D 
There are 59 entries in the compatibility table: 
NBDCND 
MBDCND 0 1 2 3 4 
1 ABCD ABCD ABCD ABCD ABCD 
2 AB AB AB AB AB 
3 A A A A A 
4 AC AC AC AC AC 
5 BD — as BD = 
6 B = ma B a 
7 CD — — CD a 
8 Cc — — C — 
9 D —_— — D oa 
The tests used eight regions: 
[TS, TF] = [7/4, 7/2] [0,7/2] [/2,7] [0,7] 
[PS, PF] = [7/2, 37/2] [0, 277]. 


The true solution was 


u = sin” 8 cos 20. 


Table I. PWSCRT Test 


M N MBC NBC Time Error 
9 15 0 0 8 0.224E—13 0.416E-01 
18 30 0 0 32 0.120E—13 0.104E—01 
36 45 0 0 96 0.971E-15 0.312E—02 
72 60 0 0 271 0.205E-13 0.116E—02 
9 15 0 1 6 0.0 0.299F—01 
18 30 0 1 23 0.0 0.748E—02 
36 45 0 1 71 0.0 0.224K—02 
72 60 0 1 198 0.0 0.838E—03 
9 15 1 0 6 0.0 0.299E—01 
18 30 1 0 22 0.0 0.743E—02 
36 45 1 0 65 0.0 0.226E—02 
72 60 1 0 178 0.0 0.837E—03 
9 15 1 1 4 0.0 0.346K—01 
18 30 1 1 16 0.0 0.870E—02 
36 45 I 1 49 0.0 0.2683E—02 
72 60 1 1 136 0.0 0.977E—03 
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Table II. PWSSSP Test 
(Region = [0,7/2] x [0,27], AX = 0.0. Times are in milliseconds.) 


M N MBC NBC Time PERTRB Error 
9 15 1 0 6 0.0 0.225E—01 
18 30 1 0 22 0.0 0.572E—02 
36 45 1 0 66 0.0 0.256E—02 
72 60 1 0 180 0.0 0.145E—02 
9 15 1 1 4 0.0 0.246E—01 
18 30 1 1 16 0.0 0.631E—02 
36 45 1 1 50 0.0 0.286E—02 
72 60 2 1 137 0.0 0.162E—02 
9 15 2 0 6 0.0 0.471E—01 
18 30 2 0 23 0.0 0.120E—01 
36 45 2 0 67 0.0 0.519E—02 
72 60 2 0 181 0.0 0.287E—02 
9 15 2 1 5 0.0 0.669E—01 
18 30 2 1 17 0.0 0.170E—01 
36 45 2 1 51 0.0 0.747E—02 
72 60 2 1 138 0.0 0.414E—02 


We close with some remarks about the accuracy and speed of the package. 
Tables I and II summarize some of the test results obtained on a 7600 at Los 
Alamos, using a local compiler similar to the FTN compiler (optimization level 
2). The CPU times, given in milliseconds, reflect the influences of boundary 
condition and mesh size and are in very good agreement with times reported in 
[2]. Error is measured in the sup norm over the interior of the mesh of (M + 1) 
x (N + 1) points; the entries indicate that the finite-difference scheme of the 
package has second-order accuracy. To see this, note that if the scheme is of 
second order, then the error on the ith mesh is approximately 


error; = aM; ? + BN;*’, 


where M,; = 9*2', N; = 15*(i + 1), 0 SiS 3. The Cartesian problem of Table I is 
symmetric about the line x = y, and so a = B. We therefore expect the ratios 
error,—:/error; to have the values of 4.00, 3.32, 2.69, respectively. For the spherical 
surface problem of Table II, a is nearly zero and the expected ratios are 4.00, 2.25, 
1.78. 

These observations—second-order accuracy and good agreement with the 
timings of [2]—hold true across the entire test set. 
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ALGORITHM 542 
Incomplete Gamma Functions [S14] 


WALTER GAUTSCHI 
Purdue University 


Key Words and Phrases: computation of incomplete gamma functions, Taylor’s series, continued 
fractions 

CR Categories: 5.12 

Language: Fortran 


DESCRIPTION 
This algorithm implements the procedure developed in [1]. 


REFERENCES 


1. GauTscuI, W. A computational procedure for incomplete gamma functions. ACM Trans. Math. 
Software 5, 4 (Dec. 1979), 466-481. 


ALGORITHM 

SUBROUTINE GAM(A, X, ACC, G, GSTAR, IFLG, IFLGST) 10 
C LET GAMMA(A) DENOTE THE GAMMA FUNCTION AND GAM(A,X) THE 20 
C (COMPLEMENTARY) INCOMPLETE GAMMA FUNCTION, 36 
Cc 40 
Cc GAM(A,X)=INTEGRAL FROM T=X TO T=INFINITY OF EXP(-T)*T**(A-1). 50 
Cc 60 
C LET GAMSTAR(A,X) DENOTE TRICOMI:S FORM OF THE INCOMPLETE GAMMA 70 
C FUNCTION, WHICH FOR A.GT.@. IS DEFINED BY 80 
Cc 90 
C GAMSTAR(A, X)=(X** (-A) /GAMMA(A))* INTEGRAL FROM T=@ TO T=X OF 100 
6 EXP (-T)*T**(A-1), 11¢ 
Cc 120 
C AND FOR A.LE.@. BY ANALYTIC CONTINUATION. FOR THE PURPOSE OF 130 
C THIS SUBROUTINE, THESE FUNCTIONS ARE NORMALIZED AS FOLLOWS& 14¢ 
C 150 
Cc GAM(A,X)/GAMMA(A), IF A.GT.@., 160 
C 170 
Cc G(A,X)= 180 
C 190 
Cc EXP (X)*X**(-A)*GAM(A,X), IF A.LE.@., 200 
C 214 
Cc GSTAR (A ,X)= (X**A) *GAMSTAR (A,X). 226 
C 230 
C THE PROGRAM BELOW ATTEMPTS TO EVALUATE G(A,X) AND GSTAR(A,X), 240 
C BOTH TO AN ACCURACY OF ACC SIGNIFICANT DECIMAL DIGITS, FOR ARBI- 250 
C TRARY REAL VALUES OF A AND NONNEGATIVE VALUES OF xX. THE SUB- 260 
C ROUTINE AUTOMATICALLY CHECKS FOR UNDERFLOW AND OVERFLOW CONDI- 270 
C TIONS AND RETURNS APPROPRIATE WARNINGS THROUGH THE OUTPUT PARA- 280 
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METERS IFLG, IFLGST. A RESULT THAT UNDERFLOWS IS RETURNED WITH 


THE VALUE @. 


» ONE THAT OVERFLOWS WITH THE VALUE OF THE LARGEST 


MACHINE-REPRESENTABLE NUMBER. 


NEAR LINES IN THE (A,X)-PLANE, A.LT.@., ALONG WHICH GSTAR 
VANISHES, THE ACCURACY SPECIFIED WILL BE ATTAINED ONLY IN TERMS 
OF ABSOLUTE ERROR, NOT RELATIVE ERROR. THERE ARE OTHER (RARE) 


INSTANCES IN 
THE ACCURACY 


WHICH THE ACCURACY ATTAINED IS SOMEWHAT LESS THAN 
SPECIFIED. THE DISCREPANCY, HOWEVER, SHOULD NEVER 


EXCEED ONE OR TWO (DECIMAL) ORDERS OF ACCURACY# NO INDICATION 
OF THIS IS GIVEN THROUGH ERROR FLAGS. 


PARAMETER LIST& 


ACC 


GSTAR - - 


IFLG 


IFLGST - - 


THE FIRST ARGUMENT OF G AND GSTAR. TYPE REAL. 

THE SECOND ARGUMENT OF G AND GSTAR. TYPE REAL. 

THE NUMBER OF CORRECT SIGNIFICANT DECIMAL DIGITS 

DESIRED IN THE RESULTS. TYPE REAL. 

AN OUTPUT VARIABLE RETURNING THE VALUE OF G(A,X). 

TYPE REAL. 

AN OUTPUT VARIABLE RETURNING THE VALUE OF 

GSTAR(A,X). TYPE REAL. 

AN ERROR FLAG INDICATING A NUMBER OF ERROR CONDI- 

TIONS IN G UPON EXECUTION. TYPE INTEGER. 

AN ERROR FLAG INDICATING A NUMBER OF ERROR CONDI- 

TIONS IN GSTAR UPON EXECUTION. TYPE INTEGER. 

THE VALUES OF IFLG AND IFLGST HAVE THE FOLLOWING 

MEANINGS& 

@ - NO ERROR CONDITION. 

1 - ILLEGAL NEGATIVE ARGUMENT X. THE ROUTINE EXITS 
WITH THE VALUES ZERO FOR G AND GSTAR. 

2 - INFINITELY LARGE RESULT AT X=@. THE ROUTINE 
RETURNS THE LARGEST MACHINE-REPRESENTABLE NUMBER. 

3 - (ONLY FOR IFLGST) GSTAR IS INDETERMINATE AT 
A=@." AND X=@. THE ROUTINE RETURNS THE VALUE 1., 
WHICH IS THE LIMIT VALUE AS X TENDS TO ZERO FOR 
FIXED A=0. 

4 — THE RESULT UNDERFLOWS. IT IS SET EQUAL TO @. 

5 - THE RESULT OVERFLOWS. IT IS SET EQUAL TO THE 
LARGEST MACHINE-REPRESENTABLE NUMBER, WITH 
PROPER SIGN. 

6 — CONVERGENCE FAILS WITHIN 660 ITERATIONS, EITHER 
IN TAYLOR:S SERIES OR IN LEGENDRE:S CONTINUED 
FRACTION. REASON UNKNOWN. THE COMPUTATION IS 
ABORTED AND THE ROUTINE RETURNS WITH ZERO 
VALUES FOR G AND GSTAR. 


ALL MACHINE-DEPENDENT PARAMETERS ARE COLLECTED IN THE FIRST 
DATA DECLARATION. THEY ARE AS FOLLOWS& 


PREC - - 


TOPEXP - — 


BOTEXF - - 


THE SINGLE PRECISION ACCURACY, TO BE 5ET APPROXI- 
MATELY EQUAL TO BETA*ALOG(2.)/ALOG(1@.), WHERE BETA 
IS THE NUMBER OF BINARY DIGITS AVAILABLE IN THE MAN- 
TISSA OF THE SINGLE PRECISION FLOATING-POINT WORD. 
TYPE REAL. 

APPROXIMATELY THE LARGEST POSITIVE NUMBER T SUCH 
THAT 10.**T IS STILL REPRESENTABLE ON THE COMPUTER 
IN SINGLE PRECISION FLOATING-POINT ARITHMETIC. 

TYPE REAL. 

APPROXIMATELY THE SMALLEST NEGATIVE NUMBER T SUCH 
THAT 1@.**T IS STILL REPRESENTABLE ON THE COMPUTER 
IN SINGLE PRECISION FLOATING-POINT ARITHMETIC. 

TYPE REAL. 


IN THE PROGRAM BELOW THESE PARAMETERS ARE SET TO CORRESPOND TO 
THE MACHINE CHARACTERISTICS OF THE CDC 659¢@ COMPUTER. 


THE SECOND DATA DECLARATION CONTAINS THE SINGLE PRECISION 
VALUE OF ALOG(1@.). THE NEXT DATA DECLARATION CONTAINS THE SUCCES- 
SIVE COEFFICIENTS IN THE MACLAURIN EXPANSION OF (1/GAMMA(A+1))-1. 
THEY ARE GIVEN TO AS MANY DECIMAL PLACES AS IS NECESSARY TO ACHIEVE 
MACHINE PRECISION (ON THE CDC 65¢@ COMPUTER) IN THE RANGE 


ABS (A) .LE..5 


. MORE ACCURATE VALUES OF THESE COEFFICIENTS (TO 


31 DECIMAL PLACES) CAN BE FOUND IN TABLE 5 OF J.W.WRENCH,JR., 
::CONCERNING TWO SERIES FOR THE GAMMA FUNCTION::, MATH. COMPUT. 
22, 1968, 617-626. 


290 
300 
319 
320 
330 
346 
350 
360 
376 
380 
390 
400 
416 
420 
436 
440 
45¢ 
460 
470 
480 
490 
560 
5106 
520 
530 
540 
550 
560 
570 
580 
590 
600 
610 
620 
630 
640 
650 
666 
676 
680 
696 
700 
710 
72¢ 
730 
740 
75 
760 
770 
780 
790 
800 
81¢ 
82¢ 
830 
846 
85 
860 
870 
880 
890 
900 
916 
920 
930 
940 
950 
960 
970 
980 
996 
166¢ 
1916 
1026 
1930 
164 


542-P 2- 


0 


COLLECTED ALGORITHMS (cont.) 


AARQAAARAARAANAAANAAAANAN 


C 


THE SUBROUTINE CALLS ON A FUNCTION SUBROUTINE, NAMED ALGA, 


WHICH IS TO PROVIDE SINGLE PRECISION VALUES OF THE LOGARITHM OF 
THE GAMMA FUNCTION FOR ARGUMENTS LARGER THAN OR EQUAL TO .5. 

A POSSIBLE VERSION OF SUCH A FUNCTION SUBROUTINE IS APPENDED 

TO THE PRESENT SUBROUTINE. IT IS TAYLORED TO THE ACCURACY RE- 
QUIREMENTS OF THE CDC 65460 COMPUTER, AND USES RATIONAL APPROXI- 
MATIONS DUE TO CODY AND HILLSTROM (MATH. COMPUT. 21, 1967, 198- 
203). 


REFERENCE - W. GAUTSCHI, ::A COMPUTATIONAL PROCEDURE FOR 


INCOMPLETE GAMMA FUNCTIONS::, ACM TRANS. MATH. SOFTWARE. 


DIMENSION C(18) 

DATA PREC, TOPEXP, BOTEXP /1.445E1,3.22E2,-2.93E2/ 

DATA AL1¢ /2.36258509299465E@/ 

DATA C /.577215664961533EQ, -.655878071520254EO, 
* ~4,2602635034095E-2, .16653861138229EG,-4. 219773455554E-2, 
* -9.62197152788E-3, 7.21894324666E-3, -1.1651675919E-3, 
* -~2,.152416741E-4, 1. 28056282E-4, -2.0134855E-5,-1.25049E-6, 
* 1,13303E-6,-2.0563E-7,6.12E-9, 5.Q@@E-9,-1.2E-9,1.E-16/ 
G= ¢. 

GSTAR = @. 

IF (X.LT.@.) GO TO 29¢ 


C INITIALIZATION 


C 


Cc 


IF (X.GT.@.) ALX = ALOG(X) 

ALPHA = X + .25 

IF (X.LT..25 .AND. X.GT.@.) ALPHA = ALOG(.5)/ALX 
ALPREC = ALI@*PREC 

TOP = AL1@*TOPEXP 

BOT = AL1@*BOTEXP 

AINF = 16.**TOPEXP 

EPS = .5*1@.**(-ACC) 

EPS1 = EPS/1i60. 


SGA = l. 

IF (A.LT.@.) SGA = -SGA 
AE=A 

AA = ABS (A) 

APl1=A+1 

AEP1 = API 

MA= .5-A 

FMA = FLOAT(MA) 

AEPS = A + FMA 

SGAE = 1 


IF (AEPS.LT.@.) SGAE = -SGAE 
AAEPS = ABS(AEPS) 
ALGP1 = @. 


C EVALUATION OF THE LOGARITHM OF THE ABSOLUTE VALUE OF 
C GAMMA(A+1.) AND DETERMINATION OF THE SIGN OF GAMMA(A+1.) 


Cc 


C 


SGGA = 1. 

IF (MA.LE.6) GO TO 1@ 

IF (AEPS.EQ.@.) GO TO 2¢ 

SGGA = SGAE 

IF (MA.EQ.2*(MA/2)) SGGA = -SGGA 

ALGP1 = ALGA(AEPS+1.) - ALOG(AAEPS) 

IF (MA.EQ.1) GO TO 20 

ALGP1 = ALGP1 + ALGA(1.-AEPS) - ALGA(FMA-AEPS) 
GO TO 26 


1@ ALGP1 = ALGA(AP1) 
2@ ALGEP1 = ALGP1 


IF (X.GT.6.) GO TO 60 


C EVALUATION OF GSTAR(A,@.) AND G(A,@.) 


C 


IF (A) 36, 40, 5@ 


36 IFLGST = 2 


GSTAR = AINF 
G = 1./AA 
RETURN 


10650 
1660 
1070 
1080 
1690 
110¢ 
1116 
1120 
113¢ 
114@ 
115@ 
1166 
1170 
118¢ 
1196 
12060 
1210 
1220 
1230 
1240 
1256 
1260 
1270 
1280 
1290 
13060 
1310 
1326 
1330 
1346 
135¢ 
1360 
1370 
1380 
1390 
1400 
1410 
1426 
1430 
1446 
1450 
1460 
1470 
1480 
1496 
1500 
151¢ 
1520 
1530 
1540 
1550 
156@ 
1576 
1580 
1590 
1600 
161¢ 
1620 
1630 
1640 
1650 
1660 
1670 
1680 
1690 
1760 
1710 
1720 
1730 
1740 
1750 
1760 
177 
1780 
1796 
186¢ 


542-P 3- 


0 


COLLECTED ALGORITHMS (cont.) 


40 IFLGST = 3 
GSTAR = l. 
IFLG = 2 
G = AINF 
RETURN 
50G=1. 
RETURN 
6@ IF (A.GT.ALPHA) GO TO 226 
IF (X.GT.1.5) GO TO 246 
IF (A.LT.-.5) GO TO 170 


AND -.5.LE.A.LE.ALPHA(X) 


CHC ea 


GSTAR = 1. , 
IF (A.GE..5) GO TO 11¢ 
7@ SUM = C(18) 
DO 8@ K=1,17 
Kl = 18 -XK 
SUM = AE*SUM + C(K1) 
86 CONTINUE 
GA = -SUM/(1.+AE*SUM) 


Y = AE*ALX 
IF (ABS(Y).GE.1.) GO TO 1060 
SUM = 1 
TERM = 1 
K=1 
Oo K=K+1 
IF (K.GT.6066) GO TO 33¢ 


TERM = Y*TERM/FLOAT(K) 

SUM = SUM + TERM 

IF (ABS(TERM).GT.EPS1*SUM) GO TO 96 
U = GA - SUM*ALX 


GO TO 124 
1¢@ U = GA - (EXP(Y)-1.)/AE 
GO TO 12@ 
116 U = EXP(ALGA(A)) - (X**A)/A 
12@ P = AE*X 
Q = AEPL 
R = AE + 3. 
TERM = Ll. 
SUM = 1. 
K=1 
13@ K=K+1 
IF (K.GT.660) GO TO 33¢ 
P=P+xX 
Q=Q+tR 
R=R+2. 
TERM = -P*TERM/Q 


SUM = SUM + TERM 
IF (ABS(TERM).GT.EPS1*SUM) GO TO 130 
V = (X**AEP1)*SUM/AEP1 
G=U+V 
IF (1.EQ.1) GO TO 18¢ 
IF (A) 14@, 15, 160 
T = EXP(X)*X**(-A) 
G = TXG 
GSTAR = 1. -— A*G*EXP(-ALGP1)/T 
RETURN 
15@ G = EXP(X)*G 
RETURN 
160 G = A*G*EXP (—ALGP1) 
GSTAR = 1. -G 
RETURN 


14¢ 


C 


C RECURSIVE EVALUATION OF G(A,X) FOR X.LE.1.5 AND A.LT.-.5 


C 
176 I= 1 
AE = AEPS 
AEP] = AEPS + 1. 


IF (X.LT..25 .AND. AE.GT.ALPHA) GO TO 216 


GO TO 7¢ 
1806 G = G*EXP (X)*X** (-AE) 
DO 19@ K=1,MA 
G = (1.-X*G)/ (FLOAT (K)-AE) 


DIRECT EVALUATION OF G(A,X) AND GSTAR(A,X) FOR X.LE.1.5 


1810 
1826 
1830 
1840 
1850 
1860 
1870 
1880 
1890 
1960 
1916 
192¢ 
1930 
1940 
1956 
1960 
1970 
1980 
1990 
2000 
2010 
2020 
2030 
2040 
20650 
2060 
2676 
2080 
2696 
2160 
2110 
212¢ 
2130 
2140 
2150 
2160 
2176 
2180 
219 
2200 
2210 
2220 
2230 
2240 
2256 
2260 
2270 
2280 
2290 
2300 
231¢ 
2320 
2330 
2340 
2350 
2360 
2370 
2380 
2390 
2400 
2410 
2420 
2436 
2440 
2450 
2460 
2476 
2486 
2490 
2500 
2510 
2520 
2530 
2546 
255 
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COLLECTED ALGORITHMS (cont.) 


19@ CONTINUE 
ALG = ALOG(G) 


O 


EVALUATION OF GSTAR(A,X) IN TERMS OF G(A,X) 


20@ GSTAR = 1. 
IF (MA.GE.@ .AND. AEPS.EQ.@.) RETURN 
SGT = SGA*SGGA 
T = ALOG(AA) - X + A*ALX + ALG - ALGP1 
IF (T.LT.-ALPREC) RETURN 
IF (T.GE.TOP) GO TO 326 
GSTAR = 1. - SGT*EXP(T) 
RETURN 
216 I = 2 
ALGEP1 = ALGA(AEP1) 


EXPANSION 


aaaAana 


226 1. 


AA YHA 
il 02a 
i} 
hr 
os 


As il 


230 +1 

IF (K.GT.6066) GO TO 340 

TERM = X*TERM/ (AE+FLOAT(K) ) 

SUM = SUM + TERM 

IF (ABS (TERM).GT.EPS*SUM) GO TO 23 
ALGS = AE*ALX - X + ALOG(SUM) - ALGEP1 
IF (ALGS.LE.BOT) GO TO 310 

GSTAR = EXP(ALGS) 

G = 1. - GSTAR 

IF (1.NE.2) RETURN 

G = G*EXP (ALGEP1)/AE 

GO TO 18¢ 


MEANS OF THE LEGENDRE CONTINUED FRACTION 


aaaan 


PAXXMA 
.*XPA 
aa 
i, 


x FP peo i u 
td 


TERM 


Sor 


250 


ry 
ron 
a 


T.600) GO TO 33¢ 


NOW N 


1.+RHO) 
Hi /(Q-T) 
TERM = RHO*TERM 
SUM = SUM + TERM 
IF (ABS (TERM).GT.EPS*SUM) GO TO 25¢ 
IF (A) 260, 270, 280 
26@ G = SUM/XPA 
ALG = ALOG(G) 
GO TO 200 
270 G = SUM/XPA 
RETURN 
28@ ALG = AXALX - X + ALOG(A*SUM/XPA) - ALGP1 
IF (ALG.LE.BOT) GO TO 340 


EUoOnNnWOoO~nN Ae HH 
HAt+tte+ at 


K 
K 
at 
P 
Q 
R 
S 
T * 
R 


Oo 


G = EXP(ALG) 
GSTAR = 1. - G 
RETURN 

290 IFLG = 1 
IFLGST = 1 
RETURN 


360 IFLG = 4 


EVALUATION OF GSTAR(A,X) FOR A.GT.ALPHA(X) BY TAYLOR 


EVALUATION OF G(A,X) FOR X.GT.1.5 AND A.LE.ALPHA(X) BY 


2560 
2570 
2580 
2590 
2600 
2610 
2620 
2636 
2646 
2650 
2660 
2670 
2680 
2690 
2760 
27106 
2720 
2730 
2740 
2750 
2760 
277 
2780 
2790 
28060 
2810 
2820 
2830 
2840 
2850 
2860 
2876 
2880 
2890 
29900 
291 
2926 
2930 
2940 
2950 
2960 
2970 
298¢ 
2990 
3060 
361¢ 
3920 
303¢ 
3040 
3050 
3060 
3070 
3080 
3690 
3100 
3116 
3126 
3130 
3140 
3156 
3160 
3176 
3180 
3190 
3200 
3210 
3220 
3230 
3240 
3250 
3260 
3270 
3280 
3290 
3300 
3316 
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COLLECTED ALGORITHMS (cont.) 


RETURN 

316 IFLGST = 4 
RETURN 

326 IFLGST = 5 
GSTAR = ~SGT*AINF 
RETURN 

33@ ILFLG = 6 
RETURN 

34@ IFLGST = 6 
RETURN 
END 


FUNCTION ALGA(X) 
DIMENSION CNUM(8), CDEN(8) 


DATA CNUM /4.1206843185847776@, 85 .68982062831317, 243.175243524421, 
* -261. 7218583856145, -922. 2613728891522, -517.6333498623218, 


* -77.41664071332953, -2. 268843997216182/, CDEN 


* /1.,45.6467718758598, 377. 8372484823942, 951. 323597679706, 
846.0755 362020782, 262. 3683470269460, 24. 4351966 2506312, 


+ 


* .4097792921092615/ 

XI = AINT(X) 

IF (X-XI.GT..5) XI = XI +1. 
M = IFIX(XI) - 1 

XE = X 

IF (M.EQ.-1) XE=X+1. 

IF (M.GT.@) XE = X - FLOAT(M) 


SNUM = CNUM(1) 
SDEN = CDEN(1) 
DO 16 K=2,8 


SNUM = XE*SNUM + CNUM(K) 
SDEN = XE*SDEN + CDEN(K) 
1@ CONTINUE 
ALGA = (XE-1.)*SNUM/SDEN 
IF (M.GT.-1) GO TO 2¢ 
ALGA = ALGA - ALOG(X) 
RETURN 
2@ IF (M.EQ.6) RETURN 
P = XE 
IF (M.EQ.1) GO TO 46 
MM1 =M- 1 


MACHINE-REPRESENTABLE NUMBER. 


AaAaQaaan 


IF (M.GE.176) GO TO 5¢ 
DO 3@ K=1,MM1 
P = (XE+FLOAT(K))*P 
3@ CONTINUE 
40 ALGA = ALGA + ALOG(P) 
RETURN 
5@ ALGA = ALGA + ALOG(XE) 
DO 6@ K=1,MM1 
ALGA = ALGA + ALOG(XE+FLOAT(K) ) 
6@ CONTINUE 


RETURN 

END 
C 
C DRIVER1 — ERROR FUNCTIONS 
C 


C ERF X FOR X=06(.65)1.5 IN SINGLE AND DOUBLE PRECISION WITH 
C RELATIVE ERROR. CHECK AGAINST TABLE 7.1 IN NBS HANDBOOK. 


Cc 


DOUBLE PRECISION DPI, DC, DX, DXSQ, DG, DGSTAR, DERF, DXMSQ, DERFC 


PI = 4.*ATAN(1.) 
DPI = 4.D¢*DATAN(1.D¢) 
WRITE (6,99999) 
DO 1@ I=1,31 
X = FLOAT(I-1)*.05 
DX = DBLE(FLOAT(I-1))*5.D-2 
XSQ = X*X 
DXSQ = DX*DX 
CALL GAM(.5, XSQ, 8., G, ERF, IFLG, IFLGST) 


CALL DGAM(.5D@, DXSQ, 16., DG, DERF, IFGD, IFGSTD) 


THE NEXT STATEMENT IS DESIGNED TO AVOID POSSIBLE OVERFLOW IN THE 
COMPUTATION OF P. THE CONDITION IN THE IF-CLAUSE EXPRESSES THE 
INEQUALITY 1*3%*5* ... *(2*M+1)/(2**M).GE.Q, WHERE Q IS THE LARGEST 


3326 
3330 
3346 
3356 
3360 
3370 
3380 
3390 
3400 
3410 
3420 


3430 
3446 
3450 
3466 
3476 
3486 
3496 
35060 
3510 
3520 
3530 
3546 
3550 
3560 
3570 
3580 
3590 
3600 
3610 
3620 
3630 
3640 
3650 
36606 
3670 
3686 
3690 
37060 
3710 
3720 
3730 
3740 
3750 
3766 
3770 
3780 
3790 
3866 
3810 
3826 
3830 
3840 
3850 
3860 
3870 
3880 
3890 
39900 
3916 
3926 
3936 
3940 
395¢ 
3966 
3970 
3986 
3996 
4600 
4610 
4920 
40630 
4640 
40650 
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ERROR = SNGL(DABS (DBLE(ERF)-DERF) ) 4960 

IF (DERF.NE.@.D@) ERROR = ABS (ERROR/SNGL(DERF) ) 4670 

WRITE (6,99998) X, ERF, DERF, ERROR, IFLG, IFLGST, IFGD, IFGSTD 4680 

1@ CONTINUE 4990 

Cc 4160 
C X*EXP(X*X)*ERFC X FOR X**(-2)=.005(.005).25 IN SINGLE AND 4116 
C DOUBLE PRECISION WITH RELATIVE ERROR. CHECK AGAINST TABLE 7.3 4126 
C IN NBS HANDBOOK. 4136 
Cc 4146 
WRITE (6,99997) 4150 

DO 3@ I=1,5¢ 4160 

XMSQ = FLOAT(I)*.@05 4170 

DXMSQ = DBLE(FLOAT(1))*5.D-3 4186 

XSQ = 1./XMSQ 4196 

DXSQ = 1.D¢/DXMSQ 4200 

CALL GAM(.5, XSQ, 7., G, GSTAR, IFLG, IFLGST) 4210 

CALL DGAM(.5D@, DXSQ, 16., DG, DGSTAR, IFGD, IFGSTD) 4220 

ERFC = @. 4230 

DERFC = @.D@ 4240 

IF (XSQ.GT.74@.) GO TO 26 4250 

ERFC = SQRT(XSQ)*EXP (XSQ)*G 4266 

DERFC = DSQRT(DXSQ)*DEXP (DXSQ)*DG 4270 

2@ ERROR = SNGL(DABS(DBLE(ERFC)-DERFC) ) 4280 

IF (DERFC.NE.@.D@) ERROR = ABS (ERROR/SNGL(DERFC) ) 4290 

WRITE (6,99996) XMSQ, ERFC, DERFC, ERROR, IFLG, IFLGST, IFGD, 4300 

*  TFGSTD 4310 

3@ CONTINUE 43206 

Cc 433 
C ERFC(SQRT(N*PI)) FOR N=1(1)1@ IN SINGLE AND DOUBLE PRECISION 4340 
C WITH RELATIVE ERROR. CHECK AGAINST TABLE 7.3 IN NBS HANDBOOK. 4350 
Cc 4360 
WRITE (6,99995) 4370 

DO 4¢ N=1,1¢ 4380 

X = FLOAT(N)*PI 439 

DX = DBLE(FLOAT(N) )*DPI 4400 

CALL GAM(.5, X, 8., ERFC, GSTAR, IFLG, IFLGST) 4410 

CALL DGAM(.5D@, DX, 16., DERFC, DGSTAR, IFGD, IFGSTD) 4426 

ERROR = ABS (SNGL( (DBLE(ERFC)—DERFC) /DERFC) ) 4430 

WRITE (6,99994) N, ERFC, DERFC, ERROR, IFLG, IFLGST, IFGD, 4440 

*  LFGSTD 4450 

46 CONTINUE 4460 
STOP 4470 

99999 FORMAT (/26X, 1HX, 8X, 5HERF X, 14X, 5HERF X, 12X, 5HERROR, 4x, 4486 
* 4HIFLG, 1X, 6HIFLGST, 2X, 4HIFGD, 1X, 6HIFGSTD/) 4490 
99998 FORMAT (2@X, E1@.2, E15.7, D23.15, E1@.2, 416) 4500 
99997 FORMAT (//23X, 7HX**(-2), 10X, 1L7HX*EXP(X*X)*ERFC X, 13X, S5HERROR, 4510 
* 4X, 4HIFLG, 1X, 6HIFLGST, 2X, 4HIFGD, 1X, 6HIFGSTD/) 4526 
99996 FORMAT (20X, E10.2, E14.6, D23.15, E1@.2, 416) 4530 
99995 FORMAT (//27X, 1HN, 13X, 16HERFC(SQRT(N*PI)), 14X, 5HERROR, 4X, 4540 
* GHIFLG, 1X, 6HIFLGST, 2X, 4HIFGD, 1X, 6HIFGSTD/) 455@ 
99994 FORMAT (128, E17.7, D23.15, E1@.2, 416) 4560 
END 4579 

C 4586 
C DRIVER3 - EXPONENTIAL INTEGRAL 4590 
Cc 4600 
C ESUBN(X) FOR N=((1)20,-X=VAR, IN SINGLE AND DOUBLE PRECISION 4610 
Cc 462¢ 
C ESUBN(X) FOR N=@(1)26, X=VAR, IN SINGLE AND DOUBLE PRECISION 4630 
C WITH RELATIVE ERROR. CHECK AGAINST TABLES I AND II IN PAGUROVA. 4640 
C 465¢ 
DOUBLE PRECISION DXl, DX2, DX, DA, DG, DGSTAR, DESUBN, DP, DANU, 4660 

* DESBNU, DLGA 4670 
DIMENSION X1(16), X2(6), DX1(1@), DX2(6) 4680 

DATA X1 /@.,.01,.05,.2,.5,1.5,5.1,10.,14.7,19.8/ 4696 

DATA X2 /.061,.37,1.44,3.02,6.57,20./ 47066 

DATA DX1 /@.D0,1.D-2,5.D-2, .2D@, .5D@,1.5D6,5.1D%,1.D1,1.47D1, 4710 

* 1.98D1/ 4720 
DATA DX2 /1.D-2,.37D6,1.44D@, 3.62D0,6.57D@, 2.D1/ 4736 
WRITE (6,99999) 4746 

DO 5@ I=1,1¢ 4750 

X = X1(1) 4760 

DX = DX1(1) 4776 

DO 4@ J=1,21 4780 


NeJ-1 479¢ 
A = FLOAT (-N+1) 4860 


COLLECTED ALGORITHMS (cont.) 


DA = DBLE(A) 
CALL GAM(A, X, 8., G, GSTAR, IFLG, IFLGST) 
CALL DGAM(DA, DX, 16., DG, DGSTAR, IFGD, IFGSTD) 
IF (X.GT.6.) GO TO 10 
ESUBN = @. 
DESUBN = @.D¢ 
IF (N.LE.1) GO TO 3¢ 
ESUBN = G 
DESUBN = DG 
GO TO 3¢ 
1d IF (N.NE.@) GO TO 2 
ESUBN = G/X 
DESUBN = DG/DX 
GO TO 3¢ 
2¢ ESUBN = EXP(-X)*G 
DESUBN = DEXP (-DX)*DG 
3¢ ERROR = SNGL(DABS (DBLE(ESUBN) -DESUBN) ) 
IF (DESUBN.NE.@.D®@) ERROR = ABS (ERROR/SNGL(DESUBN) ) 
WRITE (6,99998) N, A, X, ESUBN, DESUBN, ERROR, IFLG, IFLGST, 
* IFGD, IFGSTD 
46 CONTINUE 
WRITE (6,99997) 
5@ CONTINUE 
Cc 
C ESUBNU(X) FOR NU=@(.1)1., X#VAR, IN SINGLE AND DOUBLE 
C PRECISION WITH RELATIVE ERROR. CHECK AGAINST TABLE III IN 


C PAGUROVA. 
C 
WRITE (6,99996) 
DO 96 I=1,6 
X = X2(I) 
DX = DX2(I) 


DO 8¢@ J=1,11 
ANU = FLOAT(J-1)*.1 
A = -ANU + 1. 
DANU = DBLE(FLOAT(J-1))*.1D¢ 
DA = =-DANU + 1.D¢ 
CALL GAM(A, X, 7., G, GSTAR, IFLG, IFLGST) 
CALL DGAM(DA, DX, 16., DG, DGSTAR, IFGD, IFGSTD) 
IF (J.LT.11) GO TO 6¢ 
ESUBNU = EXP (-X)*G 
DESBNU = DEXP(-DX)*DG 


GO TO 7¢ 
60 ESUBNU = X**(-A)*EXP(ALGA(A+1.))*G/A 

DESBNU = DXx**(-DA)*DEXP (DLGA(DA+1.D@) )*DG/TA 
70 ERROR = SNGL(DABS (DBLE (ESUBNU)-DESBNU) ) 


IF (DESBNU.NE.@.D@) ERROR = ABS (ERROR/SNGL(DESBNU) ) 
WRITE (6,99995) ANU, A, X, ESUBNU, DESBNU, ERROR, IFLG, 
* IFLGST, IFGD, IFGSTD 
86 CONTINUE 
WRITE (6,99998) 
9% CONTINUE 
STOP 
99999 FORMAT (/7X, 1HN, 5X, 1HA, 8X, 1HX, 8X, 8HESUBN(X), 1@X, 6HESUBN(, 
* 2HX), 1@X, 5HERROR, 5X, 4HIFLG, 1X, 6HIFLGST, 2X, 4HIFGD, 1X, 
* 6HIFGSTD/) 
99998 FORMAT (6X, 12, El@.1, E1@.2, E15.7, D22.15, E1@.2, 416) 
99997 FORMAT (/) 
99996 FORMAT (//5X, 2HNU, 7X, 1HA, 8X, 1HX, 8X, Q9HESUBNU(X), 9X, 
* QHESUBNU(X), 9X, 5HERROQR, 5X, 4HIFLG, 1X, 6HIFLGST, 2X, 4HIFGD, 
* 1X, 6HIFGSTD/) 
99995 FORMAT (1X, 2E9.1, E1@.2, E15.7, D22.15, E1@.2, 416) 


END 
C 
C DRIVERS - CHISQUARE DISTRIBUTION 
C 


C P(CHISQUARE,NU) AND Q(CHISQUARE,NU) FOR SELECTED VALUES OF 
C CHISQUARE AND NU. CHECK AGAINST TABLE 26.7 IN NBS HANDBOOK. 
Cc 
DIMENSION CCHSQ(9), NUMAX(9) 
DATA CCHSQ /.1,1.,2.,4.,6.,8.,15.,20.,60./ 
DATA NUMAX /6,12,16, 22, 27, 4*3@/ 
WRITE (6,99999) 
DO 2¢ I=1,9 
CHSQ = CCHSQ(T) 
NUI = NUMAX(I) 
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DO 16 NU=1,NUL 5576 

A = .5*FLOAT (NU) 5580 

X = .5*CHSQ 5590 

CALL GAM(A, X, 5., Q, P, IFLG, IFLGST) 5600 

CALL GAM(A, X, 14., Q6, P@, IFLGG, IFLGS@) 5610 

ERRP = ABS (P-P@)/P@ 5626 

ERRQ = ABS(Q-Q0)/Q@ 5630 

WRITE (6,99998) NU, CHSQ, X, P, Q, ERRP, ERRQ, IFLG, IFLGST 5640 

1¢ CONTINUE 5650 
WRITE (6,99997) 5660 

20 CONTINUE 5670 
STOP 5680 

99999 FORMAT (//6X, 2HNU, 4X, Q9HCHISQUARE, 7X, 1HX, 14X, 1HP, 14x, 1HQ, 5690 
* 11X, 7HERROR P, 8X, 7HERROR Q, 5X, 4HIFLG, 2X, 6HIFLGST/) 5706 
99998 FORMAT (5X, 13, 2E13.3, 4E15.4, 216) 57106 
99997 FORMAT (/) 5720 
END 5730 

Cc MAN7 10 
C DRIVER7 - MOLECULAR INTEGRALS MAN7 2 
C ASUBNZALPHAF FOR N#(Z1F16 AND ALPHA#VAR TO 16 DECIMAL PLACES. MAN7 3@ 
C CHECK AGAINST TABLES IN MILLER,GERHAUSEN AND MATSEN. MAN7 40 
Cc MAN7 50 
DOUBLE PRECISION ALPHA, X, P, A, G, GSTAR, DG, DGSTAR, ASUBN, MAN7 60 

* DASUBN MAN7 79 
DIMENSION ALPHA%106F MAN7 80 

DATA ALPHA /.125D@, .5D@,1.625D0, 4. 25D@, 7. 375D0,9.875D0,12.625D%, MAN7 90 

* 17.125D@, 21. 25D, 25.DO/ MAN7 100 

Acc # 16. MAN7 110 

DACC # 25. MAN7 1206 

DO 4@ I#1,10 MAN7 130 

X # ALPHAZIF MAN7 140 

WRITE %6,99999F X MAN7 15 

WRITE 26,99998F MAN7 160 

DO 3@ J#1,17 MAN7 176 
N#J-1 MAN7 180 

P # 1.D0/x MAN7 19¢ 

IF ZN.EQ.@F GO TO 206 MAN7 2¢¢ 

DO 1 K#1,N MAN7 210 

P # DBLEZFLOATZKFF*P/X MAN7 220 

1¢ CONTINUE MAN7 23¢ 

20 A # DBLEZFLOATZIFF MAN7 246 
CALL DGAMZA, X, ACC, G, GSTAR, IFLG, IFLGSTF MAN7 250 

CALL DGAMZA, X, DACC, DG, DGSTAR, IFLGD, IFLGSDF MAN7 260 

ASUBN # P%G MAN7 270 

DASUBN # P*DG MAN7 280 

ERR # ABSZSNGL%ZZASUBN—DASUBNE /DASUBNFF MAN7 290 

WRITE %6,99997F N, ASUBN, DASUBN, ERR, IFLG, IFLGST, IFLGD, MAN7 300 

* IFLGSD MAN7 31¢ 

3@ CONTINUE MAN7 320 

46 CONTINUE MAN7 330 
STOP MAN7 340 

99999 FORMAT %/5X, 6HALPHA#, D11.4//F MAN7 35@ 


99998 FORMAT %12X, IHN, 7X, 12HASUBNZALPHAF, 17X, 12HASUBNZALPHAF, 16X, MAN7 360 
* SHERROR, 6X, 4HIFLG, 1X, 6HIFLGST, 1X, SHIFLGD, 1X, 6HIFLGSD/F MAN7 370 


99997 FORMAT Z1@X, 13, D24.15, D33.24, E15.4, 4I16F MAN7 38¢@ 
END MAN7 39¢ 
SUBROUTINE DGAM(A, X, ACC, G, GSTAR, IFLG, IFLGST) 5740 
DOUBLE PRECISION A, X, G, GSTAR, C, AL1@, ALX, ALPHA, ALPREC, 5750 

* TOP, BOT, AINF, EPS, EPS1, ES, SGA, AE, AA, AP1, AM1, AEP1, 5760 
* AFM1, FMA, AEPS, SGAE, AAEPS, ALGP1, SGGA, ALGEP1, SGGS, ALGS, 5770 
* ALG, SUM, GA, Y, TERM, U, P, Q, R, V, T, H, SGT, AlX, RHO, XPA, 5780 
* XMA, S, DLGA 5790 
DIMENSION C(29) 5800 
DATA PREC, TOPEXP, BOTEXP /28.8989, 322.,-293./ 5810 
DATA AL1@ /2.30258509299496456840179914547D0/ 5820 


DATA C /.5772156649061532860606512696@8D@, —. 6558780715 2625388167761 5830 
951515DO,-4. 2062635034095 2 355 2900393488D-2, .166538611382291489501 5840 
7007951D0, -4, 21977345555443367482683013D-2, -9.6219715278769735621 5850 
149217D-3, 7. 21894324666 30995423950103D-3,—-1. 165167591859965112113 5860 

* 971D-3,-2.15241674114959097281573@D-4, 1. 289562823881161861532@D-4, 5870 

* -2,013485478678823865569D-5, -1. 2564934821426706657 3D-6, 5880 


+ % 


+ 
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1.1336272319816958824D-6, -2.96563384169776067103D-7, 
6.1160951644814158D-9, 5.6620076444692229D-9, -1.18127457048762¢6D-9 
»1.04342671169119D-10, 7. 782263439905D-12,-3.696805618642D-12, 
5.1663762875D-13, -2.058326654D-14, -5. 34812254D-15, 1.2267786D-15, 
-1.181259D-16,1.187D-18,1.412D-18, -2. 3@D-19, 1. 7D-26/ 

G = 9.DO 

GSTAR = ¢.D0 

IF (X.LT.@.D@) GO TO 29¢ 


re eo 


C 

C INITIALIZATION 

C. 
LFLG = 
IFLGST 
I=@ 
IF (X.GT.@.D@) ALX = DLOG(X) 
ALPHA = X + .25D@ 
IF (X.LT..25D@ .AND. X.GT.@.D@) ALPHA = DLOG(.5D@)/ALX 
ALPREC = AL1@*DBLE (PREC) 
TOP = AL1@*DBLE(TOPEXP) 
BOT = AL1@*DBLE(BOTEXP) 

AINF = 1¢.D06**TOPEXP 

EFS = .5D@*106.DQ@** (—ACC) 

EPS1 = EPS/1.D2 

SGA = 1.D¢@ 

IF (A.LT.@.D@) SGA = -SGA 

AE=A 

AA = DABS(A) 

AP1 = A+ 1.D9 

AEP1 = AP1 

MA = SNGL(.5D@-A) 

FMA = DBLE(FLOAT (MA) ) 

AEPS = A + FMA 

SGAE = 1.D¢ 

IF (AEPS.LT.@.D@) SGAE = -SGAE 

AAEPS = DABS(AEPS) 

ALGP1 = @.D¢@ 


i) 
= 9 


C 
C EVALUATION OF THE LOGARITHM OF THE ABSOLUTE VALUE OF 
C GAMMA(A+1.) AND DETERMINATION OF THE SIGN OF GAMMA(A+1.) 
C 
SGGA = 1.D¢ 
IF (MA.LE.@) Gu TO 10 
IF (AEPS.EQ.6.D6) GO TO 2¢ 
SGGA = SGAE 
IF (MA.EQ.2*(MA/2)) SGGA = -SGGA 
ALGP1 = DLGA(AEPS+1.D@) - DLOG(AAEPS) 
IF (MA.EQ.1) GO TO 2¢ 
ALGP1 = ALGP1 + DLGA(1.D@-AEPS) - DLGA(FMA-AEPS) 
GO TO 2¢ 
16 ALGP1 = DLGA(AP1) 
26 ALGEP1 = ALGP1 
IF (X.GT.@.D6) GO TO 6¢ 
Cc 
C EVALUATION OF GSTAR(A,@.) AND G(A,@.) 
C 
IF (A) 3¢, 40, 56 
3@ IFLGST = 2 
GSTAR = AINF 
G = 1.D@/AA 
RETURN 
4@ IFLGST = 3 
GSTAR = 1.D@ 
IFLG = 2 
G = AINF 
RETURN 
5@ G = 1.D¢ 
RETURN 
6@ IF (A.GT.ALPHA) GO TO 220 
IF (X.GT.1.5D@) GO TO 24¢ 
IF (A.LT.-.5D@) GO TO 17¢ 


GSTAR = 1.D0 
IF (A.GE..5D@) GO TO 1104 
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Cc 


C RECURSIVE EVALUATION OF G(A,X) FOR X.LE.1.5 AND A.LT.-.5 


C 


aa 


C 


C EVALUATION OF GSTAR(A,X) FOR A.GT.ALPHA(X) BY TAYLOR 


7@ SUM = C(29) 
DO 8@ K=1,28 
Kl = 29 -K 
SUM = AE*SUM + C(K1) 
8@ CONTINUE 
GA = -SUM/(1.DQ@+AE*SUM) 
Y = AE*ALX 
IF (DABS(Y).GE.1.D@) GO TO 106¢ 
SUM = 1.D¢@ 
TERM = 1.D¢ 
K=1 
99 K=K+1 
IF (K.GT.606) GO TO 33¢ 
TERM = Y*TERM/DBLE (FLOAT (K) ) 
SUM = SUM + TERM 
IF (DABS (TERM).GT.EPS1*SUM) GO TO 9@ 
U = GA — SUM*ALX 


GO TO 12¢ 
106 U = GA - (DEXP(Y)-1.D0)/AE 
GO TO 120 
116 U = DEXP(DLGA(A)) - (X**A)/A 
12@ P = AE*X 
Q = AEPI 
R = AE + 3.D¢ 
TERM = 1.D¢ 
SUM = 1.D¢ 
K=1 
13@ K=K+1 
IF (K.GT.6060) GO TO 33¢ 
P=P+xX 
Q=QtR 
R=R+ 2.D0 


IF (DABS(TERM).GT.EPS1*SUM) GO TO 130 
V = (X**AEP1)*SUM/AEP1 
G=U+V 
IF (1.EQ.1) GO TO 180 
IF (A) 144, 154, 16¢ 
14@ T = DEXP(X)*X**(-A) 
G = TG : 
GSTAR = 1.D@ - A*G*DEXP(-ALGP1)/T 
RETURN 
15@ G = DEXP(X)*G 
RETURN 
16@ G = A*G*DEXP (-ALGP1) 
GSTAR = 1.D@ - G 
RETURN 


176 L=1 
AE = AEPS 
AEP1 = AEPS + 1.D@ 
IF (X.LT..25D@ .AND. AE.GT.ALPHA) GO TO 21¢ 
GO TO 7@ 
18@ G = G*DEXP (X)*X** (-AE) 
DO 19% K=1,MA 
G = (1.D@-X*G) / (DBLE(FLOAT(K) )-AE) 
19@ CONTINUE 
ALG = DLOG(G) 


EVALUATION OF GSTAR(A,X) IN TERMS OF G(A,X) 


260 GSTAR = 1.D0 
IF (MA.GE.@ .AND. AEPS.EQ.@.D0) RETURN 
SGT = SGA*SGGA 
T = DLOG(AA) - X + A*ALX + ALG - ALGP1 
IF (T.LT.-ALPREC) RETURN 
IF (T.GE.TOP) GO TO 326 
GSTAR = 1.D@ - SGT*DEXP(T) 
RETURN 
216 I = 2 
ALGEP1 = DLGA(AEP1) 


6650 
6660 
6670 
6680 
6690 
6700 
6710 
6726 
6730 
6740 
6750 
6760 
6770 
6786 
6790 
5860 
6810 
6820 
6830 
6840 
6850 
6860 
6870 
6880 
6890 
6900 
6910 
6920 
6930 
6940 
6950 
6960 
6979 
6980 
6990 
7000 
7910 
7020 
7030 
7040 
7650 
7060 
7070 
7980 
7090 
71066 
7110 
7126 
713¢ 
7146 
7156 
716¢ 
7176 
718¢ 
719@ 
7260 
7210 
7220 
7236 
7246 
7250 
7260 
7270 
7280 
7290 
7300 
7316 
7320 
7330 
7346 
7350 
7360 
7370 
7380 
7390 
7400 


542-P11- 


0 


COLLECTED ALGORITHMS (cont.) 


C EXP 


236 


C 
C EVA 


ANS ION 


K 
IF (K.GT.6@¢@) GO TO 34@ 

TERM = X*TERM/ (AE+DBLE(FLOAT(K) ) ) 

SUM = SUM + TERM 

IF (DABS (TERM) .GT.EPS*SUM) GO TO 23¢ 
ALGS = AE*ALX - X + DLOG(SUM) - ALGEP1 
IF (ALGS.LE.BOT) GO TO 316 

GSTAR = DEXP(ALGS) 

G = 1.D@ - GSTAR 

IF (I.NE.2) RETURN 

G = G*DEXP(ALGEP1) /AE 

GO TO 18¢ 


LUATION OF G(A,X) FOR X.GT.1.5 AND A.LE.ALPHA(X) BY 


C MEANS OF THE LEGENDRE CONTINUED FRACTION 


C 
240 


250 


260 


270 


280 


290 


300 
310 


320 


336 


346 


GSTAR 
XPA 


> Oo mM dX HH 


he +8 
ie 
> 


il 1oeh u How il 
or 


HnNnWDOvUANe iW i 


Pf 


ADROWDHAARNANDON 
toi oh ot 


me 
5 


TERM = RHO*TERM 

SUM = SUM + TERM 

IF (DABS (TERM).GT.EPS*SUM) GO TO 25¢ 
IF (A) 266, 276, 28¢ 

G = SUM/XPA 

ALG = DLOG(G) 

GO TO 260 

G = SUM/XPA 

RETURN 

ALG = AXALX - X + DLOG(A*SUM/XPA) - ALGP1 
IF (ALG.LE.BOT) GO TO 3@¢ 

G = DEXP (ALG) 

GSTAR = 1.D@ - G 

RETURN 

IFLG = 1 

LFLGST = 1 

RETURN 

IFLG = 4 

RETURN 

IFLGST = 4 

RETURN 

IFLGST = 5 

GSTAR = ~SGT*AINF 

RETURN 

IFLG = 6 

RETURN 

LFLGST = 6 

RETURN 

END 

DOUBLE PRECISION FUNCTION DLGA(DX) 


DOUBLE PRECISION DBNUM, DBDEN, DX, DC, DP, DY, DT, DS 


DIMENSION DBNUM(8), DBDEN(8) 


DATA DBNUM /-3.617D3,1.D6,-6.91D2,1.D0,-1.D0,1.D0,-1.D9,1.D0/, 
* DBDEN /1.224D5,1.56D2, 3.6036D5, 1.188D3,1.68D3,1.26D3,3.6D2,1.2D1/ 


DC 
DP 


- 5|D@*DLOG (8. D@*DATAN(1.D@) ) 
1.D0 
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C 


C THE CONDITIONAL CLAUSE IN THE NEXT STATEMENT EXPRESSES THE 
C INEQUALITY Y.GT.EXP(.121189*DPREC+.953995), WHERE DPREC IS THE 
C NUMBER OF DECIMAL DIGITS CARRIED IN DOUBLE PRECISION FLOATING-POINT 


DY = DX 
Y = SNGL(DY) 


C ARITHMETIC. 


C 
1¢ 


2¢ 


30 


IF (Y.GT.35.@27) GO TO 26 
DP = DY*DP 
DY = DY + 1.D¢ 
Y = SNGL(DY) 
GO TO 1¢ 
DT = 1.D6/(DY*DY) 
DS = 4,3867D4/2.44188D5 
DO 3@ I=1,8 
DS = DT*DS + DBNUM(1L)/DBDEN(I) 
CONTINUE 
DLGA = (DY-.5D@)*DLOG(DY) - DY + DC + DS/DY - DLOG(DP) 
RETURN 
END 
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ALGORITHM 543 
FFT9, Fast Solution of Helmholtz-Type 
Partial Differential Equations [D3] 


E. N. HOUSTIS 

Purdue University 

and 

T. S. PAPATHEODOROU 
Clarkson College of Technology 


Key Words and Phrases: fast Fourier transform, fast Helmholtz solver, fast Poisson solver 
CR Categories: 5.17 
Language: Fortran 


DESCRIPTION 


The algorithm given here is a complement to [1] where the description, test 
results, and references are given. 
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ALGORITHM 

c PROGRAM FFT9 (INPUT ,OUTPUT , TAPE5=INPUT , TAPE6=OUTPUT) 1@ 
Cc 20 
Cc ---- PROGRAM DESCRIPTION ---- 30 
Cc PROGRAM FFT9 USES A 4-TH OR 6-TH ORDER 9-POINT DIFFERENCE 46 
Cc FORMULA AND FAST FOURIER TRANSFORM FOR THE NUMERICAL 50 
C SOLUTION OF THE ELLIPTIC EQUATION WITH CONSTANT COEFFICIENTS 60 
Cc 70 
¢ (I) CUXX*DDXU + CUYY*DDYU + CU*U = R 80 
Cc 90 
c ON A RECTANGULAR REGION @ .LE. X .LE. SX,@ .LE. Y .LE. SY 160 
Cc AND SUBJECT TO DIRICHLET BOUNDARY CONDITIONS 119 
Cc (II) U=G ON THE BOUNDARY 12¢ 
Cc 13¢ 
Cc NOTE- THE 6-TH ORDER ALGORITHM IS APPLIED ONLY 140 
Cc TO POISSON TYPE OPERATORS 150 
C 166 
6 17@ 
Cc ---- INPUT AND OUTPUT TO FFT9 ---- 180 
Cc --PROBLEM DEFINITION-- USER SUPPLIED FORTRAN FUNCTION FOR THE 199 
Cc EVALUATION OF THE RIGHT SIDES (R,G) OF THE DIFFERENTIAL 2060 
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AAAAAADANANANDAAADANAAANANANANANDAANANDAADNDANANNDADTAANQAANAANQAAANAANAAAAAAANAAARAAAARAGANAAAAAAANA 


AND BOUNDARY OPERATORS 


REAL FUNCTION PDERGH(X,Y) 

PDERGH = R 

RETURN 

END 

REAL FUNCTION BCOND(I,X,Y,BVALUS) 


TWO DIMENSIONS 
VALUES OF BOUNDARY CONDITION ON SIDE I 
AT (X,Y) 


I I 
I I 
I=3 I REGION I I=1 
I I 
I I 


REAL BVALUS (4) 
GO TO(160,101,102,103) , I 
1@1 BVALUS(4) = G 
BCOND = BVALUS (4) 
RETURN 
102 BVALUS(4) = G 
BCOND = BVALUS(4) 
RETURN 
193 BVALUS(4) = G 
BCOND = ‘BVALUS (4) 
RETURN 
104 BVALUS(4) = G 
BCOND = BVALUS (4) 
RETURN 
END 


USER SUPPLIED SUBROUTINE FOR THE DEFINITION OF 
P.D.E CONSTANT COEFFICIENTS 


SUBROUTINE PDE(X,Y,CVALUS) 


REAL CVALUS (7) 
CVALUS (1) = CUXX 
CVALUS (3) = CUYY 
CVALUS (6) = CU 
RETURN 

END 


USER SUPPLIED FORTRAN FUNCTION FOR THE TRUE SOLUTION 


IF KNOWN 


REAL FUNCTION TRUE (X,Y) 
TRUE = ... 

RETURN 

END 


--REGION AND GRID SPECIFICATIONS-- 


SX, SY - LENGTHS OF SIDES OF RECTANGLE 


NGRIDX,NGRIDY - NUMBER OF HORIZONTAL AND 
VERTICAL MESH LINES 
1QX, IQY - EXPONENTS OF 2 


NGRIDX=2**1QX+1 ,NGRIDY=2**IQY+1 


READ (5,166) SX,SY,NGRIDX,NGRIDY 
14@ FORMAT (2F10.@, 213) 


--OUTPUT CONTROL--USER SUPPLIED DATA 
LEVEL - OUTPUT LEVEL DESIRED 
NRUNS - NUMBER OF SUCCESIVE RUNS. 


IN EACH RUN THE MESH SIZE IS 


CUT BY A FACTOR OF 2. 


ORDER - RATE OF CONVERGENCE DESIRED 
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COLLECTED ALGORITHMS (cont.) 


AN ANAQANQNAANQNAANQNAAANAANANQAANAANAAANADAANAGDANDANANDANAQADANAANAAMAAANAANAANANAAANANAAANAANAANAANAAAAAAAANAAAA 


READ(5,102) LEVEL,NRUNS ,ORDER 
162 FORMAT (312) 


IF LEVEL = ¢@ PRINT APPROXIMATE SOLUTION AT NODES 
= 1 PRINT MAXIMUM ERROR AND MAXIMUM 
RELATIVE ERROR PROVIDED TRUE SOLUTION 
IS KNOWN 
= 2 ALSO PRINT TRUE SOLUTION AND 
APPROXIMATE SOLUTION AT THE INTERIOR 
GRID POINTS 


IF ORDER : 


6 CHOOSE A 6-TH ORDER DIFFERENCE APPR.TO (1) 
--STORAGE--IT IS ASSUMED THAT 3 .LE. IXQ,IQY .LE. 7 . 

IN CASE OF FINER MESH THE DIMENSIONS REQUIRED ARE 

COMPUTED BY FORMULAS GIVEN IN ARRAY LIST DESCRIPTION. 


---- MAIN VARIABLES OF FFT9 ---- 
WORK - WORKING SPACE OF DIMENSION 
ORDER = 6 7+1Q0*MAX (NGRIDX, NGRIDY )+2*NGRIDX*NGRIDY 
ZY ~ ARRAYS USED IN THE FOURIER ANALYSIS-SYNTHESIS 
ORDER = 4 7+1@*MAX (NGRIDX, NGRIDY )+NGRIDX*NGRIDY 


DIMENSION OF 'Z,Y' IS NZD=NYD= MAX(NX,NY) 


AKX(I+1)-THE I-TH EIGENVALUE OF THE DIAGONAL BLOCK DIVIDED BY 


THE I-TH EIGENVALUE OF THE OFF DIAGONAL BLOCK 
SQUARED MINUS 2 
DIMENSION OF 'AKX' IS NAKXD = MAX(NX,NY)+2 


CORE(K) - VALUE OF APPROXIMATE SOLUTION AT NODE K 


DIMENSION OF 'CORE' IS NCORED = NX+2+(NX+1) * (NY+1) 


PTINT( )- VALUES OF G AT HALF LATTICE POINTS 
DIMENSION IS NPINTD = NX*NY 
NOTE- ARRAY 'PTINT' IS NOT USED IN CASE ORDER .EQ. 4 


GRIDX, GRIDY - GRID COORDINATES 
DIMENSION OF 'GRIDX,GRIDY' IS 
NGRDXD = NX+1,NGRDYD = NY+1 


SX, SY - LENGTHS OF RECTANGULAR REGION 
ED(I+1) - THE I-TH EIGENVALUE OF THE OFF DIAGONAL 
BLOCK.DIMENSION OF 'ED' IS NEDD = MAX(NX,NY)+2 
INDEX - INDEX VECTOR USED IN FFT ANALYSIS 
DIMENSION IS INDEXD = MAX(NX,NY) 
SI - SINES VECTOR FOR FFT ANALYSIS AND 


SYNTHESIS. DIMENSION NSID = MAX(NX,NY) 
~--- COMMON VARIABLES OF FFT9 ---- 


COMMON /MESH/ 


NX, NY - NX = 2**IQX,NY = 2**IQY 
IMIN, IMAX - RANGE OF INTERIOR NODES IN X-DIRECTION 
JMIN, JMAX ~ RANGE OF INTERIOR NODES IN Y-DIRECTION 
INC - INC = IMAX - IMIN + 3 
IRO - IRO = NX + 3 
IBCX - IBCX = 1 
IQX - EXPONENT OF 2 
IBCY - IBCY = 1 
IQY - EXPONENT OF 2 
HX, HY - MESH SIZE 
HXY2 - HXY2 = (HX/HY)**2 
PI - PI = 3.14... 
POTFAC — NORMALIZATION FACTOR = 2/NX 
COMMON /FDFORM/ 
DLEFT - DIAGONAL ENTRY OF THE OFFDIAGONAL BLOCK 
DIAG, OFFD - DIAGONAL AND OFFDIAGONAL ENTRIES OF THE 


DIAGONAL BLOCK OF THE 9-POINT FORMULA 
RF ,HH,CH,RC1,FACTOR - CONSTANTS 
COMMON /FFT/ 
eee - LOCAL VARIABLE 
---- COMMON VARIABLES DECLARATION ---- 


COMMON /MESH/ NX,NY,IMIN, IMAX,JMIN, JMAX, INC, IRO,I BCX, 1QX,IBCY,1QY, 


1HX,HY ,HXY2,PI,POTFAC,SX,SY 
COMMON /FDFORM/ DLEFT,DIAG,OFFD,RF,HH,CH,RC1, FACTOR 


4 CHOOSE A 4-TH ORDER DIFFERENCE APPR. TO (I) 
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COLLECTED ALGORITHMS (cont.) 


aaa 


aaan 


aaa 


aaanga 


aaa 


aAaaa 


aaa 


C 


RREK 


RKKK 


1 


1 


COMMON /CPDE/ CUXX,CUYY,CU 
COMMON /FFT/ N2,N4,N3,N7,IP,ISL,L1,1BCJ 
COMMON WORK (35040) 


REAL CVALUS (7) 
INTEGER ORDER 


INITIALIZATIONS 


IBCX=1 
IBCY=1 


k INPUT **kkx 
DEFINE P.D.E COEFFICIENTS 


CALL PDE (X,Y,CVALUS) 


CUXX=CVALUS (1) 
CUYY=CVALUS (3) 
CU=CVALUS (6) 


DEFINE GRID SPECIFICATIONS 


READ (5,102) SX,SY,NGRIDX,NGRIDY 
NX=NGRIDX-1 

NY=NGRIDY-1 

RNX=NX 

RNY=NY 

RALOG2=1./ALOG(2.) 
IQX=ALOG (RNX) *RALOG2 
LQY=ALOG (RNY ) *RALOG2 


DEFINE OUTPUT CONTROL AND ORDER OF FINITE DIFF2RENCE 
DESCRITIZATION FORMULA 


READ (5,163) LEVEL,NRUNS,ORDER 
OUTPUT THE INPUT DATA 


WRITE (6,104) 

WRITE (6,105) 

WRITE (6,166) CUXX,CUYY,CU 
WRITE (6,107) 

WRITE (6,108) SX,SY 

WRITE (6,109) 

WRITE (6,116) ORDER 

DO 161 NTIMES=1,NRUNS 


* DISCRETIZATION ****% 
APPROXIMATE THE DIFFERENCIAL EQUATION WITH 9-POINT DIFF.OPER. 


NAKXD=MAX@ (NX, NY )+2 
NEDD=NAKXD 
NGRDXD=NX+1 
NGRDYD=NY+1 


IAl=1 

IA2=IA1+NAKXD 

IA3=LA2+NEDD 

LA4=LA3+NGRDXD 

LA5=LA4+NGRDYD 

CALL DISCRT (ORDER,WORK(IA1) ,NAKXD,WORK(IA2) ,NEDD,WORK(IA3) ,NGR 
DXD,WORK (IA4) ,NGRDYD) 


GENERATE RIGHT SIDE OF DIFFERENCE EQUATIONS 


NCORED=NGRDXD*NGRDYD+NAKXD 
NPINTD=NCORED 

IF (ORDER.EQ.4) NPINTD=1 
IA6=IA5+NCORED 
IA7=IA6+NPINTD 


CALL RGHTSD (ORDER,WORK(1IA5) ,NCORED, WORK (IA6) ,NPINTD,WORK(IA3), 
NGRDXD, WORK (1A4) ,NGRDYD) 


C **k*kk EQUATION SOLUTION ***%%* 


173¢ 
1746 
1750 
1760 
1776 
1780 
1790 
180¢ 
1810 
1820 
1830 
1846 
1856 
1860 
1876 
1880 
189¢ 
1966 
1910 
1926 
193¢ 
1940 
1950 
1960 
1976 
1980 
199¢ 
2600 
2010 
2620 
263¢ 
2040 
2050 
2660 
20670 
20680 
2096 
2100 
211¢ 
2120 
2130 
2140 
215¢ 
2166 
2170 
218¢ 
2190 
2200 
2216 
2220 
2230 
2240 
2250 
2260 
2276 
2286 
2290 
2360 
2310 
2320 
2336 
2346 
2350 
2360 
2370 
2380 
2390 
2400 
2410 
2420 
2430 
2446 
2450 
2460 
2470 
2480 
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COLLECTED ALGORITHMS (cont.) 


aagaAaAAA aaAN 


AgMgaANgaAaAANA 


aang 


aAaAaaAaaaAND 


aaa 


aaa 


KK 


161 


192 
163 
104 
105 
106 
197 
198 


199 
11¢ 


GENERATE INDECIES AND SINES USED IN THE FOURIER ANALYSIS 
AND SYNTHESIS 


INDEXD=MAX@ (NX, NY) 

NSID=INDEXD 

IA8=IA7+INDEXD 

IA9=IA8+NSID 

CALL SETF (IBCX,1QX,WORK(IA7) , INDEXD,WORK(IA8) ,NSID) 


SOLVE THE BLOCK TRIDIAGONAL SYSTEM OF DIFFERENCE EQUATIONS 
WITH THE FAST FOURIER SERIES METHOD. 


NZD=NAKXD 

TA1Q@=IA9+NZD 

NYD=NAKXD 

CALL EQSOL (WORK(IA5) ,NCORED,WORK(IA9) ,NZD,WORK(IA8) ,NSID, WORK ( 
1  IA1@) ,NYD,WORK(IA7) , INDEXD ,WORK(IA2) ,NEDD,WORK(IA1) ,NAKXD) 


AX OUTPUT *kxeK* 


PRINTS THE COMPUTED SOLUTION AND MAX.ERROR,MAX.RELATIVE 
ERROR IF THE SOLUTION IS KNOWN 


CALL SUMARY (LEVEL,WORK(IA3) ,NGRDXD,WORK(IA4) ,NGRDYD,WORK(IA5), 
1 NCORED) 


INCREASE EXPONENT OF 2 


IQX=1QX+1 

IQY=IQY+1 

NX=2**1QX 

NY=2**1QY 
CONTINUE 
STOP 


FORMAT (2F10.@,213) 

FORMAT (312) 

FORMAT (1X,27H******% INPUT DATA *****%xx) 

FORMAT (1X,37HEQUATION. CUXX*DDXU+CUYY*DDYU+CU*U=R) 

FORMAT (1X,19HCOEFFICIENTS. CUXX=,F1@. 3, 5SHCUYY=,F10. 3, 3HCU=, F1@. 3) 
FORMAT (1X,2@HBOUNDARY COND. U = G) 

FORMAT (1X,24HREGION. @. .LE. X .LE. ,F8.3,3X,15H@. .LE. Y .LE. , 
1F8.3) 

FORMAT (1X, 25H******% SOLUTION ***x%x*x) 

FORMAT (1X, 15HDISCRETIZATION. ,5X,15,8H- ORDER ,24HDIFFERENCE APPRO 
1XIMATION) 


END 
SUBROUTINE RGHTSD (ORDER, CORE,NCORED,PTINT,NPINTD,GRIDX,NGRDXD,GRI 
1DY ,NGRDYD) 


COMPUTES RIGHT SIDE OF THE FINITE DIFFERENCE EQUATIONS 


THE ARGUMENTS - ORDER,CORE(NCORED) ,PTINT(NPINTD) ,GRIDX(NGRDXD) , 
GRIDY (NGRDYD) - DEFINED IN FFT9 MAIN PROGRAM 


INTEGER ORDER 
REAL CORE (NCORED) , PTINT (NPINTD) , GRIDX (NGRDXD) , GRIDY (NGRDYD) , BVALUS 
1(4) 


FFT9 COMMON VARIABLES 


COMMON /MESH/ NX,NY,IMIN, IMAX, JMIN, JMAX, INC, TRO, I BCX, 1QX, IBCY,IQY, 
1HX,HY ,HXY2 ,PI,POTFAC,SX,SY 
COMMON /FDFORM/ DLEFT,DIAG,OFFD,RF,HH,CH,RC1, FACTOR 


INITIALIZATIONS 


Ig=@ 
J¢=0 
ZO=0.0 
Z1=1.¢ 


2496 
2500 
251¢ 
2526 
2530 
2546 
2550 
2560 
2570 
2580 
2590 
2600 
2610 
2620 
2630 
2646 
2650 
2660 
2670 
2680 
2696 
2700 
2710 
2720 
2730 
2746 
2750 
2760 
2770 
2780 
2790 
2800 
2810 
2820 
2830 
2840 
2850 
2866 
2870 
2880 
2890 
2900 
291¢ 
2926 
2930 
2940 
2956 
2960 
2970 
2980 
2990 
3000 
3016 
3626 
3030 
3040 
3050 
3066 
3070 
3080 
3090 
3100 
3119 
3120 
3130 
3146 
3156 
316¢ 
3170 
3180 
3190 
3206 
3210 
3220 
3230 
3240 
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COLLECTED ALGORITHMS (cont.) 


aaa 


aaana 


aQaana 


161 
192 


193 


164 
165 


166 


FUNCTION EVALUATIONS 


DO 162 J=JG,NY 
W=GRIDY (J+1) 
L=IRO+INC*J 
DO 141 I=I@,NX 
=L+1 
X=GRIDX(I+1) 
CORE (K)=PDERGH (X,W) 
CONTINUE 
CONTINUE 
K=IRO 


CORNER INDECIES 


NR=LRO+NX 
NU=IRO+NY*INC 
NRU=NU+NX 


IF (ORDER.EQ.4) GO TO 1068 
INITIALIZATIONS 


DO 193 I=I0,NX 
CORE (I+1) =CORE (K) 
K=K+1 

CONTINUE 


EVALUATE RIGHT SIDE AT THE EXTRA POINTS NEEDED BY SIX 
ORDER FORMULA 


YMIDL=-HY*.5 
DO 165 J=1,NY 
L=NX* (J-1) 
YMIDL=YMIDL+HY 
XMIDL=-HX*. 5 
DO 104 I=1,NX 
XMIDL=XMIDL+HX 
K=I+L 
PTINT (K)=PDERGH (XMIDL, YMIDL) 
CONTINUE 
CONTINUE 


COMPUTE THE RIGHT SIDE OF SIX ORDER DIFFERENCE OPERATOR 


LL=IRO 
DO 167 J=JMIN, JMAX 
LL=LL+INC 
L=LL 
CNTRLF=CORE (L) 
LDOWN=L-INC 
DOWNLF=CORE (LDOWN) 
DO 166 I=IMIN, IMAX 
LUP=L+INC 
LUP2=LUP+2 
LUP1=LUP+1 
IP1=I+1 
IP2=1+2 
LP2=L+2 
K=L+1 


TEMP=DOWNLF+CORE (LUP )+CORE (LUP2)+CORE (IP2)+4.* (CNTRLF+CORE (L 


UP1)+CORE (LP2)+CORE (IP1) )+148.*CORE (K) 


CNTRLF=CORE (K) 
DOWNLF=CORE (IP1) 
CORE (I+1)=CORE (K) 
IDWN1=I+NX* (J-1) 
IDWN2=IDWN1+1 


LUP1=IDWN1+NX 
IUP2=IUP1+1 


CORE (K)=FACTOR* (TEMP+48 .* (PTINT (IDWN1)+PTINT (IDWN2)+PTINT (IU 


P1)+PTINT (IUP2))) 
L=L+1 
CONTINUE 


3250 
3260 
3270 
3280 
3290 
3300 
3310 
3320 
3330 
3346 
3350 
3360 
3370 
3380 
3390 
3400 
3410 
3426 
3430 
3440 
345¢ 
3460 
3470 
3480 
3490 
3500 
3516 
3520 
3530 
3540 
3550 
3560 
3570 
3586 
3590 
3600 
3616 
3620 
3630 
3640 
3650 
3660 
3670 
3680 
3690 
3700 
3716 
3720 
3730 
3746 
3750 
3760 
3770 
3780 
3790 
3800 
381¢ 
3820 
3830 
3846 
3850 
3860 
3876 
3880 
3890 
3900 
3910 
3920 
3930 
3940 
3950 
3960 
3970 
3986 
3990 
4600 
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COLLECTED ALGORITHMS (cont.) 
LP1=L+1 
CORE (NX+1) =CORE (LP1) 
167 CONTINUE 


GO TO 112 
168 CONTINUE 


INITIALIZATION 


aaa 


DO 1¢9 I=IMIN, [MAX 
K=K+1 

CORE (1 )=CORE (K) 
169 CONTINUE 


GENERATE RIGHT SIDE OF DIFFERENCE EQUATIONS 


aan 


L=IRO 
DO 111 J=JMIN, JMAX 
L=L+INC 
K=L 
XCENTR=CORE (I) 
KRIGHT=K+1 
DO 11@ I=IMIN, IMAX 
K=KRIGHT 
KRIGHT=K-+1 
KUP=K+INC 
XLEFT=XCENTR 
XRIGHT=CORE (KRIGHT) 
XVERT=CORE (L)+CORE (KUP) 
XCENTR=CORE (K) 
CORE (I)=XCENTR 


CORE (K)=FACTOR* (XVERT+HH* (XLEFT+XRIGHT )+CH*XCENTR) 


11¢ CONTINUE 
111 CONTINUE 


a 


112 CONTINUE 


BOUNDARY VALUES AT THE CORNERS 


aaaAaA 


CORE (IRO)=BCOND(3,@.,@. ,BVALUS) 
CORE (NR)=BCOND (2,SX,@.,BVALUS) 
CORE (NU)=BCOND (4,6. ,SY, BVALUS) 
CORE (NRU)=BCOND(1,SX,SY, BVALUS) 


ENFORCE DIRICHLET BOUNDARY CONDITIONS 


KLEFT=IRO 
KLFTUP=IRO+INC 
MRIGHT=NR 
MRGTUP=MRIGHT+INC 
CORE (KLFTUP)=BCOND (3,0. ,HY,BVALUS) 
CORE (MRGTUP)=BCOND(1,SX,HY, BVALUS) 
DO 113 J=JMIN, JMAX 
W=GRIDY (J+2) 
KLEFTD=KLEFT 
KLEFT=KLFTUP 
KLFTUP=KLFTUP+INC 
K=KLEFT+1 
MRGTD=MRIGHT 
MRIGHT=MRGTUP 
MRGTUP=MRGTUP+INC 
M=MRIGHT-1 
CORE (KLFTUP)=BCOND (3,@. ,W, BVALUS) 
CORE (MRGTUP )=BCOND(1,SX,W, BVALUS) 


CORE (K)=CORE (K) -POTFAC* (CORE (KLEFTD )+CORE (KLFTUP )+OFFD*CORE (KLE 


1 FT)) 


CORE (M)=CORE (M) -POTFAC* (CORE (MRGTD) +CORE (MRGTUP )+OFFD*CORE (MRIG 


1 4HT)) 
113 CONTINUE 
KDOWN=IRO 
KRGTD=IRO+1 
MUP=NU 
MRGTUP=NU+1 
CORE (KRGTD)=BCOND (2 ,HX,@. , BVALUS) 
CORE (MRGTUP )=BCOND (4 ,HX, SY, BVALUS) 


4016 
4626 
4930 
4046 
4650 
406 
4076 
4086 
40690 
41060 
4110 
4126 
413 
4140 
415 
4166 
4170 
4180 
4196 
4260 
4210 
4220 
4230 
4246 
4256 
4266 
4270 
4286 
4290 
4306 
4310 
432¢ 
4330 
4340 
4350 
4360 
4370 
4380 
4390 
L460 
4416 
4426 
4430 
4440 
4456 
4460 
4476 
4480 
4496 
4506 
4516 
4526 
4530 
4546 
4550 
4560 
4570 
4580 
4590 
4600 
4610 
4620 
463¢ 
4646 
4650 
4660 
4676 
4686 
4696 
4706 
4716 
4720 
4736 
4746 
4750 
4760 
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COLLECTED ALGORITHMS (cont.) 


C 
Cc 
Cc 


aaa AaAaAIaRgaAaANa 


aaa 


aang 


aaa 


114 


161 


162 
163 


DO 114 I=IMIN, IMAX 

W=GRIDX (I+2) 

KLEFTD=KDOWN 

KDOWN=KRGTD 

KRGTD=KRGTD+1 

MLFTUP=MUP 

MUP=MRGTUP 

MRGTUP=MRGTUP+1 

K=KDOWN+INC 

=MUP-INC 

CORE (KRGTD)=BCOND (2 ,W,@. , BVALUS) 

CORE (MRGTUP )=BCOND (4 ,W,SY, BVALUS) 

CORE (K)=CORE (K) -POTFAC* (CORE (KLEFTD)+CORE (KRGTD)+DLEFT*CORE (KDO 
1 WN)) 

CORE (M)=CORE (M) -POTFAC* (CORE (MLFTUP)+CORE (MRGTUP )+DLEFT*CORE (MU 
1 P)) 
CONTINUE 


CORRECT CORNERS OF RECTANGLE 


K=IRO+INC+1 

KR=K+NX-2 

KU=NU-INC+1 

KRU=KU+NX-2 

CORE (K)=CORE (K)+POTFAC*CORE (IRO) 
CORE (KR)=CORE (KR)+POTFAC*CORE (NR) 
CORE (KU) =CORE (KU)+POTFAC*CORE (NU) 
CORE (KRU) =CORE (KRU) +POTFAC*CORE (NRU) 
RETURN 


END 
SUBROUTINE EQSOL (CORE,NCORED,Z,NZD,SI,NSID,Y,NYD, INDEX, INDEXD,ED, 
INEDD , AKX, NAKXD) 


SOLVES THE BLOCK TRIDIAGONAL SYSTEM OF DIFFERENCE EQUATIONS 
USING FAST FOURIER SERIES METHOD 


THE ARGUMENTS - CORE(NCORED) ,Z(NZD) ,SI(NSID) ,¥ (NYD) , INDEX (INDEXD), 
ED(NEDD) ,AKX(NAKXD) - DEFINED IN FFT9 PROGRAM 


REAL CORE(NCORED) ,Z (NZD) ,SI(NSID) ,¥ (NYD) ,ED(NEDD) , AKX (NAKXD) 
INTEGER INDEX (INDEXD) 


FFT9 COMMON VARIABLES 


COMMON /MESH/ NX,NY,IMIN, IMAX, JMIN, JMAX, INC, IRO, BCX, 1QX, IBCY,IQY, 
1HX,HY ,HXY2,P1,POTFAC,SX, SY 

COMMON /FDFORM/ DLEFT,DIAG,OFFD,RF,HH,CH,RC1, FACTOR 

Jl=2 

J2=NY-2 


MODIFICATION OF EVEN COLUMN VECTORS 
CALL EVENRD (J1,J2,CORE,NCORED) 
PERFORM FOURIER ANALYSIS ON EVEN LINES 


K=IRO+INC*J1 

JUMP=INC+INC 

DO 161 J=J1,J2,2 
CALL FETCHX (K,Z,NZD,CORE,NCORED) 
CALL FOUR (IBCX,1QX,SI,NSID,Z,NZD,Y,NYD, INDEX, INDEXD) 
CALL STOREX (K,CORE,NCORED,Y,NYD) 

K=K+JUMP 


DIVISION BY EIGENVALUES OF OFFDIAGONAL MATRIX 


DO 163 I=IMIN, [MAX 
M=IRO+I 
DO 1@2 J=J1,I2,2 
K=M+INC*J 
CORE (K)=CORE (K) /ED(I+1) 
CONTINUE 
CONTINUE 


SOLUTION FOR EVEN LINES BY CYCLIC REDUCTION 
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COLLECTED ALGORITHMS (cont.) 


C 


aaa 


aaa 


aaa 


aaa AAARARAAARAA 


aaa 


aaa 


104 


105 


166 


101 


162 


DO 104 K=IMIN, IMAX 
A=AKX (K+1) 
L=IRO+K 
M=JUMP 
CALL CRED (IBCY,L,M,A, 1QY-1,CORE,NCORED) 


FOURIER SYNTHESIS ON EVEN LINES 


K=IRO+INC*J1 

DO 105 J=J1,J2,2 
CALL FETCHX (K,Z,NZD,CORE,NCORED) 
CALL FOUR (IBCX,1QX,SI,NSID,Z,NZD,Y,NYD, INDEX, INDEXD) 
CALL STOREX (K,CORE,NCORED,Y ,NYD) 

K=K+JUMP 


MODIFICATION OF ODD LINE VECTORS 


J2=NY-1 
Fl=1.@/POTFAC 
CALL ODDRD (F1,J2,CORE,NCORED) 


SOLUTION FOR ODD LINES BY CYCLIC REDUCTION 


A=-DIAG/OFFD 
DO 196 J=1,J2,2 
L=IRO+INC*J 
CALL CRED (IBCX,L,1,A,1QX,CORE,NCORED) 


RETURN 


END 
SUBROUTINE DISCRT (ORDER,AKX,NAKXD,ED,NEDD,GRIDX,NGRDXD , GRIDY ,NGRD 
1YD) 


SETS CONSTANTS,CALCULATE GRID SPECIFICATIONS , 9-POINT 
DIFFERENCE FORMULA AND THE EIGENVALUES OF THE DIAGONAL 
AND OFF DIAGONAL BLOCKS OF THE FINITE DIFFERENCE EQUATIONS 


THE ARGUMENTS—ORDER, AKX (NAKXD) , ED (NEDD) ,GRIDX(NGRDXD) , 
GRIDY (NGRDYD) ARE DEFINED IN FFT9 


INTEGER ORDER 
REAL AKX(NAKXD) , ED(NEDD) ,GRIDX (NGRDXD) , GRIDY (NGRDYD) 


FFT9 COMMON VARIABLES 


COMMON /MESH/ NX,NY,IMIN, IMAX,JMIN, JMAX, INC, RO, IBCX,IQX,IBCY,IQY, 
1HX,HY ,HXY2,P1,POTFAC,SX, SY 

COMMON /FDFORM/ DLEFT,DIAG,OFFD,RF,HH,CH,RC1, FACTOR 

COMMON /CPDE/ C1,C2,C3 


GENERATE CONSTANTS 


PI=3.14159265358979 
NX=2**1QX 
NY=2**1QY 

REV=1. /FLOAT (NX) 
REVY=1./FLOAT (NY) 
POTFAC=2.*REV 
HX=SX*REV 
HY=SY*REVY 
RF=PI*REV 


GENERATE GRID SPECIFICATIONS 


Ig=@ 
DO 161 I=I6,NX 
GRIDX (I+1)=FLOAT (1) *HX 
CONTINUE 
DO 1¢2 J=I6,NY 
GRIDY (J+1)=FLOAT (J) *HY 
CONTINUE 
IMIN=1 
IMAX=NX-1 
JMIN=1 
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JMAX=NY-1 
INC=IMAX-IMIN+3 
TRO=2+INC 
HXY 2= (HX/HY ) **2 


INITIALIZATIONS 


OFFD=4. 

DLEFT=4. 

DIAG=-2¢, 
FACTOR=POTFAC*HX**2/6@. 


IF (ORDER.EQ.6) GO TO 163 


GENERATE COEFFICIENTS OF 9-POINT FINITE DIFFERENCE STENSIL 
OF FOURTH ORDER 


RC1=1./C1 

C21=RC1*C2 

SIGMA=RC1*C3 

RGRID=HY /HX 

HX2=HX**2 

SIGH2=S IGMA*HX2 
SIGH12=SIGH2/12.6 
RGRSQ=RGRID**2 

QUOT=RGRSQ/C21 

RR=1.-SIGH12 

QQ=C21* (1.-SIGH12*QUOT) /RR 
DIV=RGRSQ+QQ 

OFFD=12 .*QQ*QUOT/DIV-2.@ 
DLEFT=12.*C21/DIV-2.6 

DIAG= (OFFD+2.) *RR*SIGH2-2.* (OFFD+DLEFT)-4. 
HH=QQ/C21 

CH=(12.*RR-2.)*HH-2. 
FACTOR=RC1*POTFAC*RGRSQ*HX2/DIV 
CONTINUE 


CALCULATE EIGENVALUES OF THE OFF-DIAGONAL BLOCKS AND 
DIAGONAL BLOCKS 


DO 164 I=IMIN, IMAX 
LI=I+1 
DFLI=FLOAT (I) 
TWOCOS=2 .@*COS (RF*DFLI) 
ED(II)=(DLEFT+TWOCOS) **2 
RATIO= ( (DILAGHTWOCOS*OFFD) **2) /ED (II) 
AKX (II)=-2.@+RATIO 

CONTINUE 

RETURN 


END 
SUBROUTINE EVENRD (J1,J2,CORE,NCORED) 


MODIFIES THE RIGHT SIDE ON EVEN LINE VECTORS WHERE J1 IS 
THE FIRST AND J2 THE LAST EVEN VECTOR. 


THE RIGHT SIDE AND ITS MODIFICATION ARE STORED IN ARRAY CORE 


THE ACTUAL ARGUMENT - CORE(NCORED) IS DEFINED IN FFT9 
REAL CORE (NCORED) 


FFT9 COMMON VARIABLES 


COMMON /MESH/ NX,NY,IMIN, IMAX,JMIN, JMAX, INC, IRO, IBCX,1QX,IBCY,IQY, 


1HX, HY, HXY2,P1I,POTFAC,SX,SY 
COMMON /FDFORM/ DLEFT,DIAG,OFFD,RF,HH,CH,RC1, FACTOR 


INITIALIZATIONS 


I1=IMIN 
I2=IMAX-1 
L=IRO 
JUMP=INC+INC 


DO 1@2 J=J1,J2,2 
L=L+JUMP 
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K=L 
KRIGHT=K+1 
KRDOWN=KRIGHT-INC 
KRGTUP=KRIGHT+INC 

X2=¢. 

X3=CORE (KRDOWN)+CORE (KRGTUP ) 
Y2=9.0 

Y 3=CORE (KRIGHT) 


DO 101 I=11,12 
K=K+1 
KRIGHT=KRIGHT+1 
KRDOWN=KRDOWN+1 
KRGTUP=KRGTUP+1 
X1=X2 
X2=X3 
X3=CORE (KRDOWN)+CORE (KRGTUP) 
Y1=Y2 
Y2=¥3 
Y3=CORE (KRIGHT) 
CORE1L=X1+X3+DLEFT*X2-OFFD* (Y1+¥3) -DIAG*Y2 
CORE (K)=CORE1 
1@1 CONTINUE 
K=K+1 
CORE1=X2+DLEFT*X3-OFFD*Y 2-DIAG*Y3 
CORE (K)=CORE1 
192 CONTINUE 
RETURN 


END 
SUBROUTINE ODDRD (F1,J2,CORE,NCORED) 


MODIFIES THE RIGHT SIDE ON ODD-LINE VECTORS WHERE J2 IS THE LAST 
ODD LINE.THE RIGHT SIDE AND ITS MODIFICATION IS STORED IN 
ARRAY CORE (NCORED) . 


THE ARGUMENT Fl IS A MULTIPLICATION FACTOR 
REAL CORE (NCORED) 
FFT9 COMMON VARTABLES 


COMMON /MESH/ NX,NY,IMIN,IMAX, JMIN, JMAX, INC, IRO,IBCX,1IQX,IBCY,IQY, 
1HX, HY , HXY2,PI,POTFAC,SX,SY 
COMMON /FDFORM/ DLEFT,DIAG,OFFD,RF,HH,CH,RC1,FACTOR 


DENOM=1.@/OFFD 
DLFT=DLEFT*DENOM 
CENTER=F1L*DENOM 
I2=IMAX-1 
L=IRO-INC 
JUMP=INC+INC 


DO 102 J=1,32,2 

L=L+JUMP 

K=L 

KRIGHT=K+1 

KRDOWN=KRIGHT-INC 

KRGTUP=KRIGHT+INC 

X2=0.0 

X3=CORE (KRDOWN)+CORE (KRGTUP ) 

IF (J.EQ.1) X3=CORE(KRGTUP) 

IF (J.EQ.J2) X3=CORE (KRDOWN) 

DO 1@1 I=IMIN,12 
K=K+1 
KRIGHT=KRIGHT+1 
KRDOWN=KRDOWN+1 
KRGTUP=KRGTUP+1 
X1=X2 
X2=X3 
X3=CORE (KRDOWN)+CORE (KRGTUP ) 
IF (J.EQ.1) X3=CORE(KRGTUP) 
IF (J.EQ.J2) X3=CORE(KRDOWN) 
CORE1=CENTER*CORE (K)-DENOM* (X1+X3) —-DLFT*X2 
CORE (K)=CORE1 

101 CONTINUE 
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=K+1 
CORE1=CENTER*CORE (K) -DENOM*X2-DLFT*X3 
CORE (K)=CORE1 
162 CONTINUE 
RETURN 


END 
SUBROUTINE CRED (IBC,L,M,A,1IP1,CORE,NCORED) 


SOLVES TRIANGULAR SYSTEMS BY RECURSIVE CYCLIC REDUCTION 
SEE REFERENCE @3 


IBC = 1,IP1-EXPONENT OF 2,A-DIAGONAL ELEMENT, L,M-MESH DEPENDENT 
CONSTANTS USED TO RECOVER RIGHT SIDE FROM ARRAY CORE 


REAL CORE (NCORED) 

COMMON /MESH/ NX,NY,IMIN, IMAX,JMIN, JMAX, INC, IRO,IBCX,IQX,IBCY,IQY, 
1HX,HY ,HXY2,PI,POTFAC,SX, SY 

DIMENSION BB(11) 


IP=IP1 
N2=M 
BB(1)=A 
B=A 
N4=0 
N=2**1P 
K=L+N*M 
IP=IP-1 


DO 164 Nl=1,IP 
N4=N4+1 
N3=N2 
N2=N2+N2 
J1=N2+L 
J3=K-N3 
J2=K-N2 
IF (J1.GT.J2) GO TO 162 


DO 161 J=J1,J2,N2 
JMN3=J-N3 
JIPN3=J+N3 
CORE (J) =B*CORE (J)+CORE (JMN3)+CORE (JPN3) 
1@1 CONTINUE 
162 B=B*B-2 000 
BB(N1+1)=B 
IF (B.LE.1.@E14) GO TO 164 


SHORT CUT AND SOLVE BY DIVISION IF B 
LARGER THAN DESIRED ACCURACY 


IF (J1.GT.J2) GO TO 165 


DO 143 J=J1,J52,N2 
103 CORE (J)=—-CORE (J) /B 


IF (IBC.EQ.1) GO TO 145 
104 CONTINUE 
T=L+N*M/2 
CORE (I)=-CORE(I)/B 


105 DO 108 NN=1,N4 
N1=N4-NN 
B=BB (N1+1) 
J2=K-N3 
J1=L+N3 
J1PN3=J14+N3 
CORE (J1)= (CORE (J1PN3)-CORE(J1))/B 
J2MN3=J2-N3 
CORE (J2)= (CORE (J2MN3)-CORE(J2))/B 
J1=J1+N2 
J2=J2-N2 
IF (J1.GT.J2) GO TO 167 


DO 146 J=J1,J2,N2 
JMN3=J-N3 
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JPN3=J+N3 
CORE (J)= (CORE (JMN3)+CORE (JPN3)—-CORE (J) )/B 
CONTINUE 
N2=N3 
N3=N3/2 
RETURN 


END 
SUBROUTINE STOREX (K,CORE,NCORED,Y,NYD) 


TRANSFERS DATA FROM ARRAY Y TO ARRAY CORE 
AFTER FOURIER ANALYSIS 


THE ARGUMENTS - K IS THE NODE,CORE(NCORED),Y(NYD) DEFINED IN FFT9 


REAL CORE (NCORED) ,Y (NYD) 
COMMON /MESH/ NX,NY,IMIN,IMAX, JMIN,JMAX,INC,IRO,IBCX,IQX,IBCY,IQY, 
1HX,HY ,HXY2,P1,POTFAC,SX, SY 
DO 1¢1 I=IMIN, IMAX 
KPI=K+1 
IPl=I+1 
CORE (KPI) =Y (IP1) 
CONTINUE 
RETURN 


END 
SUBROUTINE FETCHX (K,Z,NZD,CORE,NCORED) 


TRANSFERS DATA FROM ARRAY CORE TO ARRAY Z PRIOR TO 
FOURIER ANALYSIS 


THE ARGUMENTS - K NODE,Z(NZD),CORE(NCORED) ARE DEFINED IN FFT9 


REAL Z(NZD) ,CORE(NCORED) 
COMMON /MESH/ NX,NY,IMIN, IMAX, JMIN, JMAX, INC, IRO,IBCX,1IQX,IBCY,IQY, 
1HX,HY,HXY2,PI,POTFAC,SX,SY 
DO 101 I=IMIN, IMAX 
KPI=K+I 
IP1=I+1 
Z (IP1)=CORE (KPT) 
CONTINUE 
RETURN 


END 
SUBROUTINE KFOLD (INDEX, INDEXD,SI,NSID,Y,NYD,Z,NZD) 


EVALUATES THE SUMMATIONS AND DOES ALL THE MULTIPLICATIONS 
BY A RECURSIVE TECHNIQUE (SEE REFERENCE @3 ) 


THE ARGUMENTS-INDEX(INDEXD) ,SI(NSID) ,Y(NYD),Z(NZD) DEFINED IN FFT9 


REAL SI(NSID) ,Y(NYD) ,Z (NZD) 
INTEGER INDEX (INDEXD) 


FFT9 COMMON VARIABLES 
COMMON /FFT/ N2,N4,N3,N7,IP,ISL,L1,1BCJ 


JS1=N2 
I=1 
J5=ISL+N2 
IS1=ISL 
Ic1=L1 
JS1=JS1/2 


GO TO FIRST TIME IS LAST TIME 


IF (JS1.EQ.1) GO TO 166 
SN=SI (1) 

IS1=IS1+JS1 

IC1=IC1+JS1 

J3=IS1+JS1 


ISo0=1IS1-JS1 
Ico=Ic1-JS1 ‘ 
ODD1=SN* (Z (IC1)-Z (1S1) ) 
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ODD2=SN¥ (Z(1C1)+Z (IS1)) 
Z(1IC1)=Z(1C0)-ODD1 
Z(1CO)=Z (1CO)+0DD1 
Z(IS1)=-Z (1S0)+0DD2 
Z(1S0)=Z (1SO)+0DD2 
{S1=IS1+1 

1€1=1C1+1 

IF (1S1.NE.J3) GO TO 141 


[=I+1 
IS1=ISL 
IC1=L1 
JS1=JS1/2 


GO TO LAST TIME WITH K IN PAIRS 
IF (JS1.EQ.1) GO TO 107 
TAKE K IN PAIRS INTERCHANGING SN AND CS 


SN=SI (TL) 
T=I+1 
CS=SI(1) 
TS1=IS1+JS1 
IC1=IC1+JS1 
J3=I1S1+J51 


ISO0=IS1-JS1 

IcO=IC1-JS1 

ODD1=CS*z (IC1)-SN*Z (IS1) 
ODD2=SN*Z (1C1)+CS¥*Z (1S1) 
Z(1C1)=Z (ICO)-ODD1 
Z(1CO)=Z (ICO)+0DD1 
Z(1S1)=-Z (1S0)+0DD2 
Z(1S0)=Z (IS0)+0DD2 
IS1=IS1+1 

IC1l=IC1+1 

IF (IS1.NE.J3) GO TO 164 


IS1=1S1+JS1 
Ic1=IC1+JS1 
J3=181+JS1 


IS0=IS1-JS1 

IcO=IC1-JS1 
ODD1=SN*Z(1C1)-CS*zZ (1S1) 
ODD2=CS*Z (IC1)+SN*Z (1S1) 
Z(IC1)=Z (1CO)-ODD1 
Z(ICO)=Z (ICO)+0DD1 
Z(IS1)=-Z (ISO)+0DD2 
Z(ISO)=Z (I1SO)+0DD2 
IS1=IS1+1 

IC1=1C1+1 

IF (IS1.NE.J3) GO TO 165 
I[=I4+1 

IF (IS1.EQ.J5) GO TO 162 
GO TO 163 


LAST TIME IS FIRST TIME 


K1=INDEX (I) 

SN=SI (TI) 

Iso=IS1 

TS1=I$1+J81 

IcoO=IC1 

IC1=1C1+JS1 
ODD1=SN¥ (Z (IC1)-Z (181) ) 
¥ (K1+1)=Z (1C0)+0DD1 
NDUM=N3-K1+1 

Y¥ (NDUM)=Z (ICO)-ODD1 
RETURN 


LAST TIME TAKING K IN PAIRS 


K1=INDEX(L) 
SN=SI (1) 
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T=I+1 

CS=SI(T) 

ISo=IS1 

IS1=1IS1+JS1 

Ico=IC1 

Ici=ICi+JS1 

ODD1=CS*Z (1C1)-SN*Z(1S1) 
¥ (K1+1)=Z (1CO)+0DD1 
NDUM=N3-K1+1 

¥ (NDUM)=Z (1CO)-ODD1 


IS1=1S1+1 

ICl=IC1+1 

K1=INDEX (1) 

Iso=IS1 

IS1=IS1+JS1 

Ico0=IC1 

IC1=1C1+JS1 
ODD1=SN¥*Z (1C1)-CS*Z (1S1) 
Y¥ (K1+1)=Z (I1CO)+0DD1 
NDUM=N3-K1+1 

¥ (NDUM)=Z (ICO)-ODD1 


IS1=1S1+1 

IC1=ICi+1 

I=I+1 

IF (IS1.NE.J5) GO TO 147 
RETURN 


END 
SUBROUTINE FOUR (IBC1,1Q1,SI,NSID,Z,NZD,Y,NYD, INDEX, INDEXD) 


PERFORMS A SINE ANALYSIS OR SYNTHESIS ON THE INPUT 
ARRAY Z(I) , I = 2,N AND PUTS THE RESULTS IN THE ARRAY Y 


THE ARGUMENTS - ALL - DEFINED IN FFT9 MAIN PROGRAM 


REAL SI(NSID) ,Z(NZD) ,Y (NYD) 
INTEGER INDEX(INDEXD) 


FFT9 COMMON VARIABLES 
COMMON /FFT/ N2,N4,N3,N7,IP,1S1,L1,1BCK 


IBC=IBC1 
IQ=IQ1 
A5=SI (1) 
N4=2**1Q 
N3=N4 
N5=N3/4 
N7=N3/2 
N11=3*N7 
N31=N3+1 
Z(N31)=6.000 
Z(1)=06.0060 
N2=N3 


DO 141 I=2,IQ 


CALL TFOLD (1,1,Z,NZD) 
N2=N2/2 
Y¥ (N7+1)=Z (2) 
JF=N5 


DO 162 J=2,1Q 
L1=N2+1 


CALL ZERO (1,Z,NZD) 
IS1=1 


CALL KFOLD (INDEX, INDEXD,SI,NSID,Y,NYD,Z,NZD) 
11=3*JF+1 

12=4*JF 

13=11+(N2/2-1)*12 


CALL NEG (I1,13,12,¥,NYD) 
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N2=N2+N2 
JF=JF/2 
RETURN 


END 
SUBROUTINE NEG (I1,13,12,Y,NYD) 


SETS THE Y(K) K=I1,13,12 EQUAL TO -Y(K) 
THE ARGUMENT Y(NYD) IS DEFINED IN FFT9 


REAL Y(NYD) 

DO 101 K=I1,13,12 
Y¥ (K)=-Y (K) 

RETURN 


END 
SUBROUTINE ZERO (L,Z,NZD) 


SETS THE ELEMENTS OF Z(LM)=@ , LM=L+I-1,FOR I=1,N2 


REAL Z(NZD) 
COMMON /FFT/ N2,N4,N3,N7,IP,ISL,L1,IBCM 
DO 141 I=1,N2 
LDUM=L+I-1 
Z(LDUM)=6.@ 
CONTINUE 
RETURN 


END 
SUBROUTINE TFOLD (IS,L,Z,NZD) 


FOLDS THE INPUT ARRAY Z(NZD) DEFINED IN FFT9 


REAL Z(NZD) 
COMMON /FFT/ N2,N4,N3,N7,I1IP,ISL,L1,1BCN 
TH2=N2/2-1 
DO 101 I=1S,IH2 
I1=I+L 
12=N2-I+L 
A=Z (11) 
Z(11)=A-Z (12) 
Z(12)=A+Z (12) 
RETURN 


END 
SUBROUTINE SETF (IBC1,1IQ1, INDEX, INDEXD,SI,NSID) 


INITIALIZES ARRAYS SI ,INDEX FOR THE USE 
BY FOUR( SEE REFERENCE @3 ) 


THE ARGUMENTS - ALL - DEFINED IN FFT9 MAIN PROGRAM 


REAL SI(NSID) 

INTEGER INDEX(INDEXD) 
COMMON /FFT/ N2,N4,N3,N7,IP,ISL,L1,IBCO 
DPI=3.14159265358979 
IBC=LBC1 

IQ=IQ1 

N3=2**1Q 

N7=N3/2 

N5=N3/4 

T=1 

INDEX (1)=N5 

SI (1)=1.0/SQRT (2.0) 
K=1 

I=I+1 

IL=I 

IF (1.EQ.N7) GO TO 13 
K1=INDEX (K) /2 

INDEX (1I)=K1 

RK1=K1 

RN3=N3 

SI(1L)=SIN (DPI*RK1/RN3) 
K1=N7-K1 

I=I+1 
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Q 


aa 


AAAAAAANH 


aaaa 


INDEX (I)=K1 
RK1=K1 
RN3=N3 
SI (1)=SIN(DPI*RK1/RN3) 
K=K+1 
I=I+1 
IF (K.NE.IL) GO TO 142 
GO TO 161 
163 RETURN 


END 
AKEKKKAKKAAKKKA OUTPUT MODULU #kRRKAAAAKAAKKRKAAAK 


SUBROUTINE SUMARY (LEVEL,GRIDX,NGRDXD,GRIDY ,NGRDYD, CORE ,NCORED) 


PRINTS THE COMPUTED SOLUTION AND MAX. ERROR,MAX. 
RELATIVE ERROR IF THE SOLUTION IS KNOWN 

THE ARGUMENTS —- ALL - DEFINED IN FFT9 MAIN PROGRAM 
COMMON VARIABLES OF FFT9 


REAL GRIDX(NGRDXD) , GRIDY (NGRDYD) , CORE (NCORED) 


COMMON /MESH/ NX,NY,IMIN, IMAX, JMIN, JMAX, INC, RO, IBCX,1QX,IBCY,IQY, 


1HX,HY ,HXY2 ,P1, POTFAC, SX, SY 
COMMON /CPDE/ CUXX,CUYY,CU 


MSLINX=NX+1 
MSLINY=NY+1 


WRITE (6,108) MSLINX,MSLINY 
IF (LEVEL.GT.@) GO TO 163 
WRITE (6,109) 
DO 102 I=IMIN, IMAX 
DO 1@1 J=JMIN, JMAX 
K=IRO+I+INC*J 
WRITE (6,116) GRIDX(I+1) ,GRIDY (J+1) ,CORE(K) 
101 CONTINUE 
1@2 CONTINUE 


RETURN 
COMPUTE MAX.ABSOLUTE AND MAX.RELATIVE ERROR 


103 CONTINUE 
IF (LEVEL.EQ.2) WRITE (6,111) 
ERRMAX=@. 
RELMAX=@. 
DO 107 I=IMIN, IMAX 
DO 1¢6 J=JMIN, JMAX 
K=IRO+I+INC#I 
EXCT=TRUE (GRIDX(I+1) ,GRIDY (J+1) ) 
ERROR=ABS (CORE (K) -EXCT) 
IF (ERROR.LE.ERRMAX) GO TO 14 
ERRMAX=ERROR 
XMAX=GRIDX (I+1) 
YMAX=GRIDY (J+1) 
164 CONTINUE 
IF (ABS(EXCT).LT.1.E-14) EXCT=1.E-14 
RELERR=ERROR/ABS (EXCT) 
IF (RELERR.LE.RELMAX) GO TO 165 
RELMAX=RELERR 
XREL=GRIDX(I+1) 
YREL=GRIDY (J+1) 
1065 CONTINUE 


PRINT SOLUTION ,APPROXIMATE SOLUTION ,MAX.ERROR,REL.ERROR 


AT EACH POINT 


IF (LEVEL.EQ.2) WRITE (6,112) GRIDX(I+1) ,GRIDY (J+1) ,EXCT,COR 


1 E(K) , ERROR, RELERR 

106 CONTINUE 

107 CONTINUE 
WRITE (6,113) ERRMAX, XMAX, YMAX, RELMAX, XREL,YREL 
RETURN 
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C 


C 


C 
Cc 


ALGORITHMS (cont.) 


198 FORMAT (1X,22HGRID. UNIFORM X =,15,5X, 11HUNIFORM Y =,15) 

109 FORMAT (1X,36HGRID POINT APPROXIMATE SOLUTION) 

11@ FORMAT (1X, 2F8.3,12X,F1@.5) 

111 FORMAT (1X,45H GRID POINT TRUE SOL. APPR. SOL. MAX.ERROR,6X,1@H 
1REL. ERROR) 

112 FORMAT (1X,2F5.2,2F10.5,2E15. 3) 

113 FORMAT (1X, 14HMAX.ABS.ERROR=,E15.3, 3X, 3HAT ,F5.2,1H,,F5.2/1X, SHMAX 
1.R, SHEL. ERROR=,E15.3, 3X, 2HAT,F5.2, 1H, ,F5.2) 


END 
*xkKKK PROBLEM DEFINITION SUBPROGRAMS FOR A TEST EXAMPLE ***%% 


REAL FUNCTLIONPDERGH (X,Y) 
PDERGH=6 . *X*Y*EXP (X) *EXP (Y) * (X*Y+X+Y- 3.) 
RETURN 


END 

REAL FUNCTION BCOND(I,X,Y,BVALUS) 
REAL BVALUS (4) 

BVALUS (4)=@. 

BCOND=BVALUS (4) 

RETURN 


END 

FUNCTION TRUE(X,Y) 

TRUE=3 .*EXP (X) *EXP (Y) * (X-X*X) * (Y-Y*Y) 
RETURN 


END 
SUBROUTINE PDE (X,Y,CVALUS) 
REAL CVALUS (7) 


CVALUS (1)=1. 
CVALUS (3)=1. 
CVALUS (6)=@. 
RETURN 


END 


154 
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ALGORITHM 544 


L2A and L2B, Weighted Least Squares 


Solutions by Modified Gram—Schmidt 
with Iterative Refinement [F4] 


ROY H. WAMPLER 
National Bureau of Standards 


Key Words and Phrases: covariance matrix, curve fitting, iterative refinement, least squares 


solution, linear constraints, overdetermined system of equations, regression, underdetermined 


system of equations 
CR Categories: 5.14, 5.5 
Language: PFORT, a portable subset of ANSI Fortran 


DESCRIPTION 


The two algorithms given here are a complement to [1] where the types of 
problems which can be solved by L2A and L2B, together with the method of 
solution and details of the calling sequences, are described. 


REFERENCES 


1. WAMPLER, R.H. Solutions to weighted least squares problems by modified Gram-Schmidt with 
iterative refinement. ACM Trans. Math. Software 5, 4(Dec. 1979), 457-465. 


ALGORITHM 


C MAIN PROGRAM TO CALL SUBROUTINES L2A AND L2B FOR SOLVING LINEAR 
C LEAST SQUARES PROBLEMS. 


C 


C VERSION OF NOVEMBER 2, 1978. 


C 


C WRITTEN BY ROY H. WAMPLER, STATISTICAL ENGINEERING 
C LABORATORY, NATIONAL BUREAU OF STANDARDS, 
C WASHINGTON, D. C. 20234. 


Cc 


C THE MAIN PROGRAM READS AND PRINTS THE INPUT DATA, CALLS EITHER 
C SUBROUTINE L2A OR L2B, COMPUTES CERTAIN QUANTITIES DERIVED FROM 
C OUTPUT OF THE SUBROUTINE, AND PRINTS COMPUTED RESULTS. 


Cc 


C SEE COMMENTS AT THE BEGINNING OF SUBROUTINES L2A AND L2B FOR A 


C DESCRIPTION OF THE INPUT, OUTPUT AND INTERNAL 


C IN THE CALLS TO THOSE SUBROUTINES. 


Cc 


C,MODE IS A PARAMETER WHICH CONTROLS WHETHER SUBROUTINE L2A OR 
C SUBROUTINE L2B SHALL BE CALLED BY THIS MAIN PROGRAM. THE TWO 
C SUBROUTINES WILL FURNISH THE SAME SOLUTIONS WHENEVER THE COMPUTED 


C RANK OF THE SYSTEM OF M EQUATIONS IN N UNKNOWNS. EQUALS N AND M.GE.N. 


C IN CASES WHERE THE COMPUTED RANK N1 IS LESS THAN N, THE USER 

C SPECIFIES THE TYPE OF SOLUTION TO BE COMPUTED ACCORDING TO WHETHER 
C MODE = 1 OR MODE = 2. 

C MATRIX A IS THE GIVEN MATRIX OF A SYSTEM OF M LINEAR EQUATIONS IN N 


C UNKNOWNS. 


MATRIX W IS A GIVEN DIAGONAL MATRIX OF WEIGHTS WITH ALL 


VARIABLES WHICH APPEAR 


DRV 
DRV 
DRV 
DRV 
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DRV 
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DRV 
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DRV 
DRV 
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DIAGONAL ELEMENTS NONNEGATIVE. LET H = (SQRT(W))*A. 


ic 
(o) 
Oo 
ics] 
i] 


1 INDICATES THAT IF N1.LT.N THE ORIGINAL MATRIX H (M BY N) 
IS TO BE REPLACED BY A SMALLER MATRIX (M BY N1) WHOSE 
COLUMNS ARE LINEARLY INDEPENDENT, AND A SOLUTION IS TO BE 
SOUGHT FOR THE SMALLER SYSTEM OF EQUATIONS. THUS N - N1 
COLUMNS OF THE ORIGINAL MATRIX H ARE DELETED, AND 
COEFFICIENTS CORRESPONDING TO THESE N - Nl DELETED COLUMNS 
WILL BE SET EQUAL TO ZERO. 

INDICATES THAT A SOLUTION IS SOUGHT FOR A LEAST SQUARES 
PROBLEM HAVING N ELEMENTS IN THE SOLUTION VECTOR. IN ORDER 
TO OBTAIN A UNIQUE SOLUTION, THE CONDITION THAT THE 
SOLUTION VECTOR BE OF MINIMAL EUCLIDEAN NORM IS IMPOSED. 


S 
=) 
t= 
il 
np 


Cc 

C 

Cc 

C 

Cc 

C 

Cc 

c 

Cc 

C 

fe 

C 

C 

C 

C THE SEQUENCE OF INPUT CARDS FOR THIS MAIN PROGRAM IS -- 

C @. CARD SPECIFYING MODE DESIRED FOR PROBLEMS WHICH FOLLOW, IN (15) 
C FORMAT. 

C 1. PROBLEM HEADING CARD, IN (8@A1) FORMAT. 

C 2. PARAMETER CARD IN (615,5X,F10.6) FORMAT, GIVING VALUES OF THE 
C PARAMETERS M, N, M1, L, ITYPE, IWGHT, TOL. 

c UM TOTAL NUMBER OF EQUATIONS. 

c UN NUMBER OF UNKNOWN COEFFICIENTS. 

C Ml NUMBER OF LINEAR CONSTRAINTS (@.LE.M1.LE.M AND M1.LE.N). 
ec 72 NUMBER OF RIGHT-HAND SIDES (VECTORS OF OBSERVATIONS) . 
Cc ITYPE PARAMETER WHICH SPECIFIES WHETHER OR NOT DATA FOR A 
Cc POLYNOMIAL TYPE FIT ARE TO BE READ IN. 

Cc ITYPE = 1 INDICATES POLYNOMIAL TYPE. 

C ITYPE = 2 INDICATES NON-POLYNOMIAL TYPE. 

C  IWGHT PARAMETER WHICH SPECIFIES WHETHER OR NOT WEIGHTS ARE TO 
C BE READ IN. 

Cc IWGHT = 1 INDICATES WEIGHTS ARE NOT TO BE READ IN. (THE 
Cc PROGRAM SETS ALL WEIGHTS EQUAL TO 1.¢@.) 

C IWGHT = 2 INDICATES WEIGHTS ARE TO BE READ IN. 

C TOL PARAMETER USED IN DETERMINING THE RANK OF MATRIX H. 
C NOTE -- 

c (1) IF TOL EQUALS ZERO, THE TOLERANCE USED IN THE 

Cc DECOMPOSITION SUBROUTINE WILL BE BASED ON MACHINE 

C PRECISION. 

c (2) IF TOL IS GREATER THAN ZERO, THIS VAI.UE OF TOL WILL BE 
Cc USED IN SETTING AN ABSOLUTE TOLERANCE FOR COMPARISON 

C WITH DIAGONAL ELEMENTS OF THE TRIANGULAR MATRIX OBTAINED 
C IN THE DECOMPOSITION SUBROUTINE. THE VALUE OF TOL CAN 
C BE BASED ON KNOWLEDGE CONCERNING THE ACCURACY OF THE 

c DATA. 

C 3. CARD GIVING FORMAT OF THE DATA CARDS (CONTAINING A, B AND 

C POSSIBLY W) WHICH FOLLOW. THIS FORMAT CARD IS IN (8@A1) 

C FORMAT. 

C 4, DATA CARDS FOR THE ARRAYS A, B AND POSSIBLY W. THERE ARE FOUR 

C POSSIBLE CONFIGURATIONS FOR THE DATA, DEPENDING ON THE VALUES 

C OF ITYPE AND IWGHT. (FOR POLYNOMIAL FITS, THE FIRST POWER OF A 
Cc IS READ IN AND HIGHER POWERS ARE COMPUTED BY THE PROGRAM WHEN 

C  N.GT.2.) THE FOUR CONFIGURATIONS ARE ILLUSTRATED BELOW BY 

Cc SHOWING WHAT THE CARD (OR CARDS) FOR THE I-TH ROW OF DATA 

C CONTAINS. 

C A. ITYPE = 1, IWGHT = 1. 

Cc POLYNOMIAL TYPE FIT. EQUAL WEIGHTS, NOT TO BE READ IN. 

C A(I,2) B(1,1) B(I,2) ... BC(I,L) 

CB. ITYPE = 1, IWGHT = 2. 

Cc POLYNOMIAL TYPE FIT. UNEQUAL WEIGHTS, TO BE READ IN. 

C A(I,2) B(I,1) B(I,2) ... B(I,L) W(Z) 

C CC. ITYPE = 2, IWGHT = 1. 

C NON-POLYNOMIAL TYPE FIT. EQUAL WEIGHTS, NOT TO BE READ IN. 

C A(I,1) A(I,2) ... A(I,N) B(I,1) B(1,2) ... B(I,L) 

C OD. ITYPE = 2, IWGHT = 2. 

Cc NON-POLYNOMIAL TYPE FIT. UNEQUAL WEIGHTS, TO BE READ IN. 

C A(I,1) A(1,2) ... AC(I,N) B(I,1) B(I,2) ... B(I,L) W(1) 

C 5. CARD IN (I5) FORMAT GIVING VALUE OF THE PARAMETER IFDONE. IF 

C THE PROBLEM AT HAND IS TO BE FOLLOWED BY ANOTHER PROBLEM, 

Cc IFDONE = 1. OTHERWISE, IFDONE EQUALS ANY INTEGER EXCEPT 1. 

C 
C 
Cc 
C 


DIMENSIONS OF ARRAYS ARE SET ASSUMING THAT M.LE.21, N.LE.8, AND 
L.LE.3. 


INTEGER IPIVOT (8) 
REAL A(21,8), B(21,3), RES(21,3), TOL, W(21), X(8,3) 
C ARRAYS Q AND R ARE USED IN SUBROUTINE L2A. 
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COLLECTED ALGORITHMS (cont.) 
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ARAARAAAN 


aaa 


aa 


Qa 


ARRAY QR IS USED IN SUBROUTINE L2B. 
REAL Q(21,8), R(8,8) 
REAL QR(29,8) 
SUBROUTINE L2A REQUIRES THAT C BE DIMENSIONED AT LEAST 4*(M+N) + 2*L. 
SUBROUTINE L2B REQUIRES THAT C BE DIMENSIONED AT LEAST 6*(M+N) + 2*L. 
REAL C(18@) 
REAL SD, SDX(8), SNORM, SS, Z 
LOGICAL FAIL(3) 
DIMENSION HEAD(8@), IFMT(8@) 


IN THE FOLLOWING DATA STATEMENT, NR IS THE CARD READER DEVICE 
AND NW IS THE PRINTER DEVICE NUMBER. 


DATA NR,NW /5,6/ 


THE PARAMETERS MM, NN AND MMPNN WHICH APPEAR IN THE STATEMENTS 
CALL L2A(...) AND CALL L2B(...) ARE USED IN SETTING ADJUSTABLE 
DIMENSIONS OF ARRAYS. THEY ARE GIVEN SPECIFIC VALUES IN THE 
FOLLOWING DATA STATEMENTS. MMPNN IS USED ONLY IN CALL L2B(...). 


DATA MM,NN /21,8/ 
DATA MMPNN /29/ 


READ (NR,9973@) MODE 
DEFAULT VALUE FOR MODE IS 1. 


IF (MODE.NE.2) MODE = 1 
IPROB = @ 
10 READ (NR,9999¢) HEAD 
IPROB = IPROB + 1 
WRITE (NW,9998@) IPROB 
WRITE (NW,9997@) HEAD 
READ (NR,9996¢) M,N,M1,L,ITYPE, LWGHT, TOL 
WRITE (NW, 99950) 
WRITE (NW,99946) M,N,M1,L,ITYPE, IWGHT,MODE,TOL 
READ (NR,99996) IFMT 
WRITE (NW,9993@) IFMT 
GO TO (26,106), ITYPE 


TYPE 1. POLYNOMIAL FIT. 
26 GO TO (30,50), IWGHT 
A. EQUAL WEIGHTS, NOT TO BE READ IN. 
3@ DO 4@ I=1,M 
READ (NR,IFMT) A(I,2),(B(I,K) ,K=1,L) 
W(I) = 1.0 
46 CONTINUE 
GO TO 7@ 
B. UNEQUAL WEIGHTS, TO BE READ IN. 
5@ DO 6¢ I=1,M 
READ (NR,IFMT) A(I,2),(B(I,K),K=1,L) ,W(I) 
6@ CONTINUE 
76 DO 9% I=1,M 
A(I,1) = 1.0 
IF (N.LT.3) GO TO 9¢ 
DO 8¢ J=3,N 
A(L,J) = A(L,2)**(J-1) 
8¢@ CONTINUE 
9% CONTINUE 
GO TO 15¢ 


TYPE 2. NON-POLYNOMIAL FIT. 
16@ GO TO (116,130), IWGHT 
C. EQUAL WEIGHTS, NOT TO BE READ IN. 
11@ DO 12¢@ I=1,M 
READ (NR,IFMT) (A(I,J),J=1,N), (B(I,K) ,K=1,L) 
W(I) = 1.@ 
12@ CONTINUE 
GO TO 15¢ 
D. UNEQUAL WEIGHTS, TO BE READ IN. 
136 DO 140 I=1,M 
READ (NR,IFMT) (A(I,J),J=1,N), (B(I,K) ,K=1,L) ,W(L) 
140 CONTINUE 
15@ IF (M1L.EQ.@ .OR. IWGHT.EQ.1) GO TO 170 


INSURE THAT WEIGHTS EQUAL 1.@ FOR THE FIRST Ml EQUATIONS WHEN M1 
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C 
C 


aagaaaaa 


IS GREATER THAN ZERO. 


DO 16@ I=1,M 
W(1) = 1.¢ 
16@ CONTINUE 


af 


PRINT A, B AND W. 


17@ WRITE (NW,99920) 
KZ = 6 
DO 18¢ I=1,M 
IF (W(1).EQ.@.0) KZ = KZ + 
WRITE (NW,99910) (A(I,J),J= 
18@ CONTINUE 


»N), (B(I,K) ,K=1,L) ,W(1) 


GO TO (199,200), MODE 


199 CALL L2A(M, N, Ml, L, A, B, W, TOL, MM, NN, 
* Nl, IPIVOT, X, RES, R, Q, C, IFAULT) 


GO TO 210 


20@ CALL L2B(M, N, Ml, L, A, B, W, TOL, MM, NN, MMPNN, 
* Nl, IPIVOT, X, RES, QR, C, IFAULT) 


PRINT COMPUTED RESULTS. 


21@ WRITE (NW,99900) 
WRITE (NW,9989@) MODE,IFAULT 
IF (IFAULT.GE.1 .AND. IFAULT.LE.4) GO TO 39¢ 
WRITE (NW,99880) N1 
IF (N1.EQ.6) GO TO 3906 
IF (N1.LT.M1) GO TO 39¢ 
WRITE (NW,99870) 
WRITE (NW,9986@) (IPIVOT(J),J=1,N1) 
IF (N1.EQ.N) GO TO 22¢ 
NIP1 = Nl +1 
WRITE (NW,99850) 
WRITE (NW,998606) (IPIVOT(J),J=N1P1,N) 
22@ NDF = M - NI - KZ 
WRITE (NW,9972@) KZ,NDF 
WRITE (NW,9984¢) 
DO 24% K=1,L 
K2=L+K 
IF (C(K).LT.@.6) GO TO 23¢ 
FAIL(K) = .FALSE. 
WRITE (NW,99830) K,C(K),C(K2) 
GO TO 246 
23@ FAIL(K) = .TRUE. 
C(K) = -C(K) 
WRITE (NW,9982@) K,C(K),C(K2) 
240 CONTINUE 
IF (IFAULT.EQ.7) GO TO 39¢ 
DO 35@ K=1,L 


COMPUTE SUM OF SQUARED RESIDUALS, NORM OF RESIDUALS, RESIDUAL 
STANDARD DEVIATION, STANDARD DEVIATIONS OF COEFFICIENTS, AND 
PREDICTED VALUES. PRINT THESE QUANTITIES, TOGETHER WITH 
COEFFICIENTS, OBSERVED VALUES AND RESIDUALS. 


IF (FAIL(K)) GO TO 35@ 
WRITE (NW,9981@) K 
SS = 0.0 
IF (M.EQ.M1) GO TO 310 
MIP1 = M1 + 1 
DO 25@ I=M1P1,M 
SS = SS + (RES(I,K)*W(1))**2 
25@ CONTINUE 
IF (M.LE.N1+KZ) GO TO 31¢ 
IF (MODE.EQ.2 .AND. N1.LT.N) GO TO 310 
SD = SQRT(SS/FLOAT (NDF) ) 
IF (MODE.EQ.2) GO TO 27¢ 
DO 26@ J=1,N 
IF (R(J,J)-LT.9.9) R(J,J) = 0.0 
SDX(J) = SD*SQRT(R(J,J)) 
269 CONTINUE 
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DRV 
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DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
DRV 
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DRV 
DRV 
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DRV 
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1790 
1800 
181¢ 
1820 
183¢ 
184¢ 
185¢ 
1860 
187¢ 
1880 
1890 
1900 
191¢ 
1920 
1930 
1940 
1950 
1960 
1970 
198 
1999 
2000 
2010 
2020 
2030 
2640 
2050 
2060 
2070 
20680 
20906 
2100 
211¢ 
2126 
2130 
2140 
215¢ 
2160 
2170 
2180 
2190 
2200 
221¢ 
2226 
2230 
2240 
225@ 
226¢ 
2276 
2280 
2296 
2300 
2310 
2320 
2330 
2340 
2350 
2360 
2370 
2380 
2390 
2460 
2410 
2426 
2430 
2446 
2450 
2460 
247¢ 
2480 
2490 
250¢ 
251¢ 
252¢ 
253¢ 
2540 
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GO TO 29¢ 
276 DO 28¢ J=1,N 
IF (QR(J,J).LT.@.0@) QR(J,J) = 0.0 
SDX(J) = SD*SQRT(QR(J,J)) 
286 CONTINUE 
290 WRITE (NW,998¢0) 
DO 3¢¢@ J=1,N 
WRITE (NW,99770) J,X(J,K),SDX(J) 
306 CONTINUE 
GO TO 330 
310 WRITE (NW,9979@) 
DO 32@ J=1,N 
WRITE (NW,99770) J,X(J,K) 
32@ CONTINUE 
330 WRITE (NW,9978@) 
DO 34@ I=1,M 


Z= 


B(I,K) - RES(I,K) 


WRITE (NW,99770) 1,B(I,K),Z,RES(I,K) 
346 CONTINUE 
SNORM = SQRT(SS) 
WRITE (NW,9976¢) SS,SNORM 
IF ((MODE.EQ.2 .AND. N1.LT.N) .OR. (M.EQ.NI+KZ)) GO TO 35¢ 
WRITE (NW,9975@) SD 
350 CONTINUE 


Cc 
C PRINT LOWER TRIANGULAR PORTION OF SYMMETRIC UNSCALED COVARIANCE 
C MATRIX. 
C 
IF (MODE.EQ.2 .AND. N1.LT.N) GO TO 39¢ 
WRITE (NW,9974@) 
IF (MODE.EQ.2) GO TO 37¢ 
DO 36@ I=1,N 
WRITE (NW,99916) (R(1I,J),J=1,1) 
360 CONTINUE 
GO TO 39¢ 
37@ DO 386 I=1,N 
WRITE (NW,9991@) (QR(I,J),J=1,1) 
380 CONTINUE 
390 READ (NR,9973@) IFDONE 
IF (IFDONE.EQ.1) GO TO 1¢ 
Cc 
STOP 
Cc 
C FORMAT STATEMENTS. 
Cc 
99999 FORMAT (8@A1) 
9998@ FORMAT (1H1,115(1H*) ,4X, 7HPROBLEM, 14) 
9997@ FORMAT (1H@,8@A1) 
9996@ FORMAT (615,5X,F1@.¢@) 
9995@ FORMAT (1H@,3X,1HM, 4X,1HN, 3X, 2HM1, 4X, 1HL, 5X, 5HITYPE, 5X, 4HIWGH, 
* 1HT,6X, 4HMODE, 7X, 3HTOL) 
9994 FORMAT (415, 3116,G15.8) 
9993@ FORMAT (8H@FORMAT ,8(@A1) 
99926 FORMAT (41H@MATRIX A, MATRIX B AND VECTOR OF WEIGHTS/) 
99916 FORMAT (1X, 8615.8) 
99996 FORMAT (17H@COMPUTED RESULTS) 
9989 FORMAT (7H@MODE =,14,5X,8HIFAULT =,14) 
9988@ FORMAT (44H@N1 = COMPUTED RANK OF SYSTEM OF EQUATIONS =,14) 
99870 FORMAT (5@H@COLUMNS OF H = (SQRT(W))*A WERE SELECTED BY THE P, 
* 37HIVOTING SCHEME IN THE FOLLOWING ORDER/) 
9986@ FORMAT (3014) 
9985@ FORMAT (5@H@THE FOLLOWING COLUMNS OF H ARE LINEARLY DEPENDENT, 
* 48H. IF MODE 1, THEY DID NOT ENTER THE REGRESSION./6H IF MO, 
* 24HDE 2, THEY ENTERED LAST./) 
99849 FORMAT (1H@,15X,9HREPORT ON,12X,9HNUMBER OF, 4X,11HESTIMATED N, 
* 16HUMBER OF CORRECT/13H B-VECTOR NO. ,3X, 11HCONVERGENCE, 16x, 
* I@HITERATIONS , 3X,26HDIGITS IN INITIAL SOLUTION/) 
9983@ FORMAT (17,9X, 9HCONVERGED, 14X,F4.0,1@X,G15.8) 
9982@ FORMAT (17,9X,18HFAILED TO CONVERGE, 5X,F4.0,1@X,G15.8) 
99816 FORMAT (26H@SOLUTION FOR B-VECTOR NO. ,13) 
99800 FORMAT (1H@,27X,18HSTANDARD DEVIATION/5X,1HJ,4X, 1@HCOEFFICIEN, 
* 4HT(J),5X,17HOF COEFFICIENT (J)/) 
9979@ FORMAT (1H@O,4X,1HJ, 4X, 14HCOEFFICIENT (J) /) 
9978@ FORMAT (1H@,4X,1HI,4X,11HOBSERVED (I) , 9X, 12HPREDICTED (1) ,10X, 
* LIHRESIDUAL (TI) /) 
9977@ FORMAT (16,G17.8,2G21.8) 
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2550 
2560 
2570 
2580 
2590 
2600 
2616 
2620 
2630 
2640 
2650 
2660 
2670 
2680 
2690 
2706 
2716 
2720 
2730 
2740 
2750 
2760 
2776 
2780 
2796 
2800 
2810 
2826 
2830 
2840 
28590 
2860 
2870 
2886 
2890 
2906 
2916 
2926 
2930 
2946 
295 
2960 
2979 
2980 
2990 
3000 
3010 
3020 
3030 
3040 
3050 
3060 
3076 
3080 
3090 
3100 
3119 
3120 
3130 
3149 
3150 
316¢ 
3179 
3180 
319¢@ 
3200 
3210 
3220 
3230 
3240 
3250 
3260 
327 
328¢ 
3296 
3300 
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99760 FORMAT (3@H@SUM OF SQUARED RESIDUALS  =,G15.8/1X,8HNORM OF , 
* QHRESIDUALS, 11X, 1H=,G15.8) 

9975@ FORMAT (30H RESIDUAL STANDARD DEVIATION =,G15.8) 

99746 FORMAT (27H@UNSCALED COVARIANCE MATRIX/) 

99730 FORMAT (15) 

99726 FORMAT (25H@NUMBER OF ZERO WEIGHTS =,13,5X,17HDEG. OF FREEDOM =,13)DRV 
END 


AHaanaanaagaaangagngaaaganannanaanaanananananannaagnanannangaananaganaangananaananananaannanaaaanaagnaaan 


SUBROUTINE L2A(M, N, Ml, L, A, B, W, TOL, MM, NN, 

* Nl, IPIVOT, X, RES, R, Q, C, IFAULT) 
*k PURPOSE ** 
SUBROUTINE L2A COMPUTES LEAST SQUARES SOLUTIONS TO OVERDETERMINED 
SYSTEMS OF LINEAR EQUATIONS. ‘THE METHOD USED IS A MODIFIED 
GRAM-SCHMIDT ORTHOGONAL DECOMPOSITION WITH ITERATIVE REFINEMENT OF 
THE SOLUTION. THE SOLUTION MAY BE SUBJECT TO LINEAR EQUALITY 
CONSTRAINTS. OUTPUT INCLUDES THE LEAST SQUARES COEFFICIENTS, 
RESIDUALS, UNSCALED COVARIANCE MATRIX, AND INFORMATION ON THE 
BEHAVIOR OF THE ITERATIVE REFINEMENT PROCEDURE. 
MATRIX A IS THE GIVEN MATRIX OF A SYSTEM OF M LINEAR EQUATIONS IN N 


UNKNOWNS, AND MATRIX W IS A GIVEN DIAGONAL MATRIX OF WEIGHTS WITH ALL 


DIAGONAL ELEMENTS NONNEGATIVE. LET H = (SQRT(W))*A. 

IN THE EVENT THAT Nl (THE COMPUTED RANK OF MATRIX H) IS LESS THAN N 

(THE NUMBER OF UNKNOWN COEFFICIENTS), THE ORIGINAL MATRIX H (M BY N) 
IS REPLACED BY A SMALLER MATRIX (M BY N1) WHOSE COLUMNS ARE LINEARLY 
INDEPENDENT, AND A SOLUTION IS SOUGHT FOR THE SMALLER SYSTEM OF 


EQUATIONS. 


AND COEFFICIENTS CORRESPONDING TO THESE N - Nl DELETED COLUMNS WILL 
BE SET EQUAL TO ZERO. 


*k INPUT VARIABLES ** 


M 
N 
M1 
L 
A 


TOL 


MM 


NN 


TOTAL NUMBER OF EQUATIONS. 

NUMBER OF UNKNOWN COEFFICIENTS. 

NUMBER OF LINEAR CONSTRAINTS (@.LE.M1.LE.M AND M1.LE.N). 

NUMBER OF RIGHT-HAND SIDES (VECTORS OF OBSERVATIONS). 

TWO-DIMENSIONAL ARRAY OF SIZE (MM,N). ON ENTRY, THE ARRAY A 

CONTAINS THE GIVEN MATRIX OF A SYSTEM OF M LINEAR EQUATIONS 

IN N UNKNOWNS, WHERE THE FIRST Ml EQUATIONS ARE TO BE 

SATISFIED EXACTLY. A IS LEFT INTACT ON EXIT. 

TWO-DIMENSIONAL ARRAY OF SIZE (MM,L). ON ENTRY, B CONTAINS 

THE L GIVEN RIGHT-HAND SIDES (VECTORS OF OBSERVATIONS). B IS 

LEFT INTACT ON EXIT. 

VECTOR OF SIZE M. ON ENTRY, W CONTAINS THE DIAGONAL ELEMENTS 

OF A GIVEN DIAGONAL MATRIX OF WEIGHTS, ALL NONNEGATIVE. 

(THE FIRST Ml ELEMENTS OF W ARE SET EQUAL TO 1.6 BY THE 

PROGRAM WHEN Ml IS GREATER THAN ZERO.) ON EXIT, THE ORIGINAL 

ELEMENTS OF W HAVE BEEN REPLACED BY THEIR SQUARE ROOTS. 

PARAMETER USED IN DETERMINING THE RANK OF MATRIX H. 

NOTE -- 

(1) IF TOL EQUALS ZERO, THE TOLERANCE USED IN SUBROUTINE 
DECOM1 WILL BE BASED ON MACHINE PRECISION. 

(2) IF TOL IS GREATER THAN ZERO, THIS VALUE OF TOL WILL BE 
USED IN SETTING AN ABSOLUTE TOLERANCE FOR COMPARISON WITH 
‘DIAGONAL ELEMENTS OF THE TRIANGULAR MATRIX OBTAINED IN 
SUBROUTINE DECOM1. THE VALUE OF TOL CAN BE BASED ON 
KNOWLEDGE CONCERNING THE ACCURACY OF THE DATA. 

DIMENSIONING PARAMETER SPECIFYING MAXIMUM NUMBER OF ROWS IN 

THE ARRAYS A, B, RES AND Q. MM MUST SATISFY MM.GE.M. 

DIMENSIONING PARAMETER SPECIFYING MAXIMUM NUMBER OF ROWS IN 

THE ARRAYS X AND R. NN MUST SATISFY NN.GE.N. 


** QUTPUT VARIABLES AND INTERNAL VARIABLES ** 


N1 
IPIVOT 


COMPUTED RANK OF MATRIX H, WHERE H = (SQRT(W))*A. 

VECTOR OF SIZE N. ON EXIT, THIS ARRAY RECORDS THE ORDER 

IN WHICH THE COLUMNS OF H WERE SELECTED BY THE PIVOTING 
SCHEME IN THE COURSE OF THE ORTHOGONAL DECOMPOSITION. 
WHENEVER N1.LT.N, THE FIRST Nl ELEMENTS OF [PIVOT INDICATE 
WHICH COLUMNS OF H WERE FOUND TO BE LINEARLY INDEPENDENT. 
TWO-DIMENSIONAL ARRAY OF SIZE (NN,L). ON EXIT, X CONTAINS 
THE SOLUTION VECTORS. 

TWO-DIMENSIONAL ARRAY OF SIZE (MM,L). ON EXIT, RES CONTAINS 
THE RESIDUAL VECTORS. 

TWO-DIMENSIONAL ARRAY OF SIZE (NN,N). ON EXIT, R CONTAINS 
THE LOWER TRIANGULAR PORTION OF THE SYMMETRIC UNSCALED 
COVARIANCE MATRIX. (THIS ARRAY IS USED INTIERNALLY TO STORE 


THUS N — N1 COLUMNS OF THE ORIGINAL MATRIX H ARE DELETED, 


DRV 
DRV 
DRV 
DRV 
DRV 


DRV : 
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RESULTS FROM SUBROUTINE DECOM1 WHICH ARE DESTROYED IN 
COMPUTING THE COVARIANCE MATRIX.) 
Q TWO-DIMENSIONAL ARRAY OF SIZE (MM,N) USED INTERNALLY ONLY. 
C VECTOR HAVING AT LEAST 4*(M+N)+2*L ELEMENTS USED (1) FOR 


INTERNAL WORK SPACE AND (2) FOR RETURNING INFORMATION ON THE 
BEHAVIOR OF THE ITERATIVE REFINEMENT PROCEDURE. 
(A) NUMIT IS THE NUMBER OF ITERATIONS CARRIED OUT DURING THE 
ITERATIVE REFINEMENT IN ATTEMPTING TO OBTAIN A SOLUTION 
FOR THE K-TH RIGHT-HAND SIDE. 
ON EXIT, C(K) = +NUMIT IF THE SOLUTION CONVERGED, AND 
C(K) = -NUMIT IF THE SOLUTION FAILED TO CONVERGE. 
(B) DIGITX GIVES AN ESTIMATE OF THE NUMBER OF CORRECT DIGITS 
IN THE INITIAL SOLUTION OF THE COEFFICIENTS FOR THE K-TH 
RIGHT-HAND SIDE. ON EXIT, C(K+L) = DIGITX. 

IFAULT FAULT INDICATOR WHICH IS ZERO IF NO ERRORS WERE ENCOUNTERED 
AND POSITIVE IF ERRORS WERE DETECTED OR IF EVIDENCE OF SEVERE 
ILL-CONDITIONING WAS FOUND. DIAGNOSTIC MESSAGES ARE PRINTED 
FROM SUBROUTINE ERROR. IF IFAULT IS SET EQUAL TO 1, 2, 3, 4, 
5, 6 OR 7, EXECUTION IS TERMINATED. EXECUTION CONTINUES WHEN 
IFAULT IS SET EQUAL TO 8, 9 OR 16 PROVIDED THAT A SOLUTION 
WAS OBTAINED FOR AT LEAST ONE RIGHT-HAND SIDE. THE VALUE OF 
IFAULT IS USED TO INDICATE THE FOLLOWING -- 

= NO ERRORS ENCOUNTERED. 

BAD INPUT PARAMETER (M, N OR L). 

BAD INPUT PARAMETER (M1). 

BAD DIMENSION. EITHER M.GT.MM OR N.GT.NN. 

AT LEAST ONE WEIGHT IS NEGATIVE. 

EITHER MATRIX H OR MATRIX OF CONSTRAINTS EQUALS ZERO. 

CONSTRAINTS ARE LINEARLY DEPENDENT. 

ALL SOLUTIONS FAILED TO CONVERGE. 

SOLUTION FAILED TO CONVERGE FOR AT LEAST ONE RIGHT-HAND 

SIDE. 

LARGE NUMBER OF ITERATIONS REQUIRED FOR CONVERGENCE. 

ESTIMATED NUMBER OF DIGITS IN INITIAL SOLUTION OF 

COEFFICIENTS IS SMALL. 

DIAGONAL ELEMENT OF COVARIANCE MATRIX WAS COMPUTED TO BE 

NEGATIVE OWING TO ROUNDING ERROR. 


ONNULPWNHE S 


e 
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** SUBROUTINES REQUIRED ** 
SUBROUTINE DECOM1 
USES MODIFIED GRAM~SCHMIDT ALGORITHM WITH PIVOTING TO 
OBTAIN AN ORTHOGONAL DECOMPOSITION OF THE INPUT MATRIX. 
SUBROUTINE SOLVE1 
COMPUTES COEFFICIENTS AND RESIDUALS. ITERATIVE REFINEMENT IS 
USED TO IMPROVE THE ACCURACY OF THE INITIAL SOLUTION. 
SUBROUTINE COVAR 
COMPUTES UNSCALED COVARIANCE MATRIX OF THE COEFFICIENTS. 
SUBROUTINE ERROR 
PRINTS ERROR DIAGNOSTICS WHEN ERRORS ARE DETECTED OR WHEN 
EVIDENCE OF SEVERE ILL-CONDITIONING IS FOUND. 


** STORAGE REQUIREMENTS ** 

THE STORAGE REQUIRED FOR THE DIMENSIONED ARRAYS IN SUBROUTINE L2A IS 
M*(2*N + 2*L +5) + N*(N +L +5) + 2*L 

LOCATIONS. ALL ARRAYS REQUIRED IN SUBROUTINES CALLED BY L2A ARE 

DECLARED HEREIN AND ARE TRANSMITTED ONLY THROUGH PARAMETER LISTS OF 

CALL-SEQUENCES. 


** PRECISION OF ARITHMETIC CALCULATIONS ** 

SINGLE PRECISION ARITHMETIC IS USED FOR ALL CALCULATIONS EXCEPT THE 
DOUBLE PRECISION ACCUMULATION OF INNER PRODUCTS. (THE VARIABLE SUM 
IS DECLARED TO BE DOUBLE PRECISION IN SUBROUTINES DECOM1, SOLVE1 AND 
COVAR.) IT IS ESSENTIAL FOR THE SUCCESS OF THE ITERATIVE REFINEMENT 
PROCEDURE THAT INNER PRODUCTS BE ACCUMULATED IN DOUBLE PRECISION. 


** CONVERSION OF THE PROGRAM TO DOUBLE PRECISION ** 
KREKEKERKEKKERERREKREKEKERERERERRERRRERKERREREREREREREREREEEKEREREERERREEE 
ON COMPUTERS HAVING SHORT WORD LENGTH (AS THE IBM 360/370) IT MAY * 
BE DESIRABLE TO PERFORM ALL CALCULATIONS IN DOUBLE PRECISION. IN * 
THIS CASE, THE ITERATIVE REFINEMENT PRESENTLY INCLUDED IN SOLVE] * 
SHOULD BE OMITTED. 

TO CONVERT THE PROGRAM TO DOUBLE PRECISION, THE FOLLOWING 
APPROACH IS SUGGESTED. 


+e be OF 


1. VARIABLES PRESENTLY DECLARED TO BE REAL SHOULD BE DECLARED 


670 
680 
6990 
700 
71¢ 
720 
730 
746 
750 
760 
770 
780 
790 
860 
81¢ 
820 
830 
84¢ 
85¢ 
860 
87 
88¢ 
899 
900 
910 
926 
93¢ 
940 
95¢ 
96¢ 
970 
980 
99¢ 
106¢ 
161¢ 
1620 
1630 
1640 
1650 
1660 
196706 
1680 
169¢ 
1160 
111¢ 
112¢ 
113¢ 
1146 
115¢ 
1160 
1176 
118¢ 
119¢ 
1260 
1210 
122¢ 
123¢ 
1240 
125¢ 
1260 
1270 
128¢ 
1290 
1306 
1310 
1320 
1330 
1346 
1350 
136¢ 
137@ 
1380 
1390 
14060 
141¢ 
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DOUBLE PRECISION. THOSE TYPED INTEGER, DOUBLE PRECISION AND 

LOGICAL SHOULD NOT BE CHANGED. 

THE USE OF FAIL, NUMIT AND DIGITX SHOULD BE OMITTED. 

DESCRIPTION OF VARIABLE C (AT L2A 76¢-806@) SHOULD READ -- 

C VECTOR HAVING AT LEAST 4*(M+N) ELEMENTS USED ONLY FOR 
INTERNAL WORK SPACE. 

THE VALUE OF ETA (AT L2A 193@) SHOULD BE SET SO THAT IT IS THE 

SMALLEST POSITIVE DOUBLE PRECISION NUMBER SUCH THAT 1.@ + ETA 

IS GREATER THAN 1.@ IN DOUBLE PRECISION ARITHMETIC. 

FOR IBM COMPUTER TYPE, ETA = 16.**(-13) 

FOR UNIVAC COMPUTER TYPE, ETA = 2.**(-59) 

THE FOLLOWING FORTRAN FUNCTIONS SHOULD BE CHANGED -- 

SINGLE PRECISION NAME DOUBLE PRECISION NAME 
DBLE (X) x 
FLOAT (N) DBLE (FLOAT (N) ) 
SQRT (X) DSQRT (X) 

DBLE(X) IS USED IN SUBROUTINES DECOM1, SOLVE1 AND COVAR. 

FLOAT(N) IS USED IN SUBROUTINE DECOM1. 

SQRT(X) IS USED IN SUBROUTINE L2A. 

6. IT MAY BE NECESSARY OR DESIRABLE TO CHANGE CERTAIN FORMATS IN 
SUBROUTINE ERROR, REPLACING G SPECIFICATIONS BY D. 

7. REPLACE STATEMENT L2A 245% BY A STATEMENT READING 

K3=1 

8. FURTHER DETAILS ARE GIVEN IN SUBROUTINE SOLVEL IN CONNECTION 
WITH THE OMISSION OF ITERATIVE REFINEMENT. 

9. IN SUBROUTINE L2A, STATEMENTS L2A 9604-10616, 1790-1800, 1994, 
2320-23306, 2430-2446, 2976, 3176-3460 AND 348-3516 SHOULD BE 
OMITTED. 

STATEMENT NUMBERS GIVEN HERE REFER TO THOSE IN THE RIGHT-HAND 
MARGIN. CERTAIN COMMENTS IN SUBROUTINE L2A DO NOT APPLY TO 
THE DOUBLE PRECISION VERSION. 


lo N 
o 


S 


Ww 


i i ee ee 
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INTEGER IPIVOT(N) 

REAL A(MM,N), B(MM,L), C(1), ETA, Q(MM,N), R(NN,N), 
* RES(MM,L), TOL, W(M), X(NN,L), Z 

REAL DIGITX 

LOGICAL FAIL 

LOGICAL SING 


SET VALUE OF ETA, A MACHINE-DEPENDENT PARAMETER. 

ETA, THE RELATIVE MACHINE PRECISION, IS THE SMALLEST POSITIVE REAL 
NUMBER SUCH THAT 1.6 + ETA IS GREATER THAN 1.@ IN FLOATING-POINT 
ARITHMETIC. 


FOR IBM COMPUTER TYPE, ETA = 16.**(-5) 
FOR UNIVAC COMPUTER TYPE, ETA = 2.**(-26) 
FOR CDC COMPUTER TYPE, ETA = 2.**(-47) 
FOR HONEYWELL COMPUTER TYPE, ETA = 2.**(-27) 
ETA = 2.**(-26) 
DEFAULT VALUE FOR TOL IS ZERO. 
IF (TOL.LT.@.@) TOL = ¢.@ 
LFAULT = @ 
KSUM = @ 


PERFORM INITIAL CHECKING OF INPUT PARAMETERS, DIMENSIONS AND 
WEIGHTS FOR POSSIBLE ERRORS. 


IF (M.GT.@ .AND. N.GT.@ .AND. L.GT.@) GO TO 1¢ 


LFAULT = 1 
CALL ERROR(IFAULT, K, Z) 
RETURN 

1@ IF (ML.LE.M .AND. M1.LE.N .AND. M1.GE.@) GO TO 26 
EFAULT = 2 
CALL ERROR(IFAULT, K, Z) 
RETURN 

20 IF (M.LE.MM .AND. N.LE.NN) GO TO 3@ 
LFAULT = 3 
K=1 
CALL ERROR(IFAULT, K, Z) 
RETURN 


3¢@ DO 46 I=1,M 


i ee ee 2 


1420 
1436 
144¢ 
145¢ 
1466 
1470 
1486 
149@ 
1500 
1510 
1520 
1530 
1540 
1550 
1560 
1570 
1580 
1596 
1600 
1610 
1620 
1630 
1646 
165@ 
166 
1676 
1680 
1690 
1700 
1716 
1726 
1730 
1740 
1756 
1760 
1770 
1780 
1790 
180¢ 
1810 
1826 
1830 
1840 
185@ 
186@ 
1870 
1880 
1890 
1960 
1916 
1926 
1930 
1940 
1950 
1960 
1970 
1986 
1996 
2000 
2010 
2026 
2630 
2040 
2050 
2060 
2070 
2080 
2690 
2106 
2110 
2126 
2136 
2146 
2150 
216¢ 
2170 
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IF (M1.GT.@ .AND. I.LE.M1) W(1) = 1.¢ 
IF (W(I).GE.@.6) GO TO 4¢ 
IFAULT = 4 
Z = W(1) 
CALL ERROR(IFAULT, I, Z) 
46 CONTINUE 
IF (IFAULT.EQ.4) RETURN 
DO 5@ I=1,M 
W(L) = SQRT(W(I)) 
5@ CONTINUE 


SET PARAMETERS WHICH ALLOCATE VECTOR C TO CONTAIN CERTAIN FINAL 
RESULTS AND ALSO TO BE USED AS WORK SPACE. 


Kl IS STARTING POINT FOR NUMIT AND FAIL, OF LENGTH L. 

K2 IS STARTING POINT FOR DIGITX, OF LENGTH L. 

K3 IS STARTING POINT FOR D, OF LENGTH N. 

STARTING POINT FOR K-TH COLUMN OF B, OF LENGTH M. 
K5 IS STARTING POINT FOR K-~TH COLUMN OF X, OF LENGTH N. 
K6 IS STARTING POINT FOR K-TH COLUMN OF RES, OF LENGTH M. 
K7 IS STARTING POINT FOR WORK SPACE OF LENGTH M. 

K8 IS STARTING POINT FOR WORK SPACE OF LENGTH M. 

K9 IS STARTING POINT FOR WORK SPACE OF LENGTH N. 

K1@ IS STARTING POINT FOR WORK SPACE OF LENGTH N. 


qQaqnnagaaaagaaangaaa 
wz 
Lf 
tH 
wn 


Kl = 1 

K2 = K1 + L 
K3 = K2 + L 
K4 = K3 +N 
K5 = K4 + M 
K6 = KS +N 
K7 = K6 + M 
K8 = K7 + M 
K9 = K8 + M 


MULTIPLY EACH ROW OF MATRIX A (M BY N) BY ITS APPROPRIATE WEIGHT AND 
STORE THE RESULT IN ARRAY Q. SET ARRAYS C AND R EQUAL TO ZERO. 


aaaAn 


DO 6@ I=1,K 
C(I) = ¢.¢ 
6@ CONTINUE 
DO 9¢@ J=1,N 
DO 7¢ I=1,M 
Q(I,J) = ACI,J)*W(I) 
7@ CONTINUE 
DO 8@ I=1,N 
R(I,J) = 0.¢ 
80 CONTINUE 
96 CONTINUE 


OBTAIN AN ORTHOGONAL DECOMPOSITION OF THE MATRIX Q AND COMPUTE ITS 
RANK. 


aag.aAN 


CALL DECOM1(M, N, Ml, ETA, TOL, Q, R, C(K3), N1, IPIVOT, SING, 
* MM, NN) 


IF (.NOT.SING) GO TO 11¢ 
IF (N1.GT.6) GO TO 16¢ 
IFAULT = 5 
CALL ERROR(IFAULT, K, Z) 
RETURN 
166 IFAULT = 6 
CALL ERROR(IFAULT, K, Z) 
RETURN 
Cc 
C SEEK A SOLUTION (COEFFICIENTS AND RESIDUALS) FOR EACH OF THE L LEAST 
C SQUARES PROBLEMS WHOSE RIGHT-HAND SIDES ARE GIVEN IN THE ARRAY B. 
C 
11% DO 200 K=1,L 
C K-TH RIGHT-HAND SIDE. 
KO = K4 - 1 
DO 12@ I=1,M 
K@ = K@ +1 
C(KO) = BC(I,K) 
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L2A 
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L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
L2A 
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2180 
2196 
2200 
2216 
2226 
2230 
2240 
2250 
2260 
2270 
2280 
2290 
2300 
2319 
2320 
2330 
2340 
2350 
2360 
2370 
238¢ 
2390 
2406 
241¢ 
242@ 
2430 
2440 
2450 
2460 
2470 
2486 
2496 
2500 
2510 
2520 
2530 
2546 
2550 
2560 
2570 
2580 
2590 
26060 
2610 
2620 
2630 
2646 
2650 
2660 
2670 
2680 
2690 
2700 
2716 
2720 
273¢ 
2740 
2750 
2760 
2770 
2780 
2790 
28060 
2810 
2820 
2830 
2840 
2850 
2860 
2876 
2880 
2890 
2900 
2910 
2920 
2930 
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COLLECTED ALGORITHMS (cont.) 
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12@ CONTINUE 


CALL SOLVE1(M, N, Ml, A, C(K4), W, Nl, IPIVOT, Q, R, C(K3), 
* ETA, FAIL, NUMIT, DIGITX, 
* C(K5), C(K6), C(K7), C(K8), C(K9), C(K10), MM, NN) 


K@ = K5 - 1 
DO 13¢@ J=1,N 
KG = KG + 1 
X(J,K) = C(K@) 
13@ CONTINUE 
IF (M1.EQ.6) GO TO 15¢ 
DO 14@ I=1,M1 
RES(1,K) = @.@ 
14@ CONTINUE 
15@ MI1Pl = M1 +1 
IF (M1P1.GT.M) GO TO 170 
K@ = K6 + M1 - 1 
DO 16¢ I=M1P1,M 
KO = KO + 1 
RES(I,K) = C(K@) 
16@ CONTINUE 
17@ CONTINUE 


FOR RIGHT-HAND SIDES WHERE CONVERGENCE OF A SOLUTION IS REPORTED, 

A CHECK IS MADE FOR EVIDENCE OF SEVERE ILL-CONDITIONING. SUCH 
EVIDENCE IS FURNISHED BY LARGE VALUES OF NUMIT (NUMBER OF ITERATIONS 
BEFORE CONVERGENCE WAS OBTAINED) AND SMALL VALUES OF DIGITX 
(ESTIMATE OF THE NUMBER OF CORRECT DIGITS IN THE INITIAL SOLUTION 


OF THE COEFFICIENTS). IF NUMIT EXCEEDS -ALOG1@(ETA) A DIAGNOSTIC 
MESSAGE IS PRINTED TO WARN OF ILL-CONDITIONING. I} DIGITX IS LESS 


THAN @.5 (HALF A DECIMAL DIGIT) A SIMILAR DIAGNOSTIC MESSAGE IS 
PRINTED. 


C(K) = FLOAT (NUMIT) 
IF (FAIL) C(K) = -C(K) 
K@ =K2+K-1 
C(K@) = DIGITX 
IF (.NOT.FAIL) GO TO 180 
KSUM IS A TALLY OF SOLUTIONS WHICH FAILED TO CONVERGE. 
KSUM = KSUM + 1 
IFAULT = 8 
CALL ERROR(IFAULT, K, Z) 
GO TO 2060 
18@ Z = -ALOGI@(ETA) 
IF (FLOAT(NUMIT).LE.Z) GO TO 19¢ 
IFAULT = 9 
Z = FLOAT (NUMIT) 
CALL ERROR(IFAULT, K, Z) 
196 IF (DIGITX.GE.@.5) GO TO 26¢ 
IFAULT = 1¢ 
Z = DIGITX 
CALL ERROR(IFAULT, K, Z) 
2¢@ CONTINUE 
IF (KSUM.LT.L) GO TO 21 


IFAULT = 7 
CALL ERROR(IFAULT, K, Z) 
RETURN 


COMPUTE THE UNSCALED COVARIANCE MATRIX OF THE COEFFICIENTS. 
21@ CALL COVAR(N, Ml, N1, IPIVOT, R, C(K3), C(K9), NN) 


IN CERTAIN PROBLEMS, SOME DIAGONAL TERMS OF THE UNSCALED COVARIANCE 
MATRIX ARE EQUAL TO ZERO OR TO SMALL POSITIVE NUMBERS. BECAUSE OF 
ROUNDING ERRORS, COMPUTED VALUES FOR THESE TERMS MAY BE SMALL 
NEGATIVE NUMBERS. AN ERROR DIAGNOSTIC IS PRINTED IF ANY DIAGONAL 
TERM IS NEGATIVE. 


DO 229 J=1,N 
IF (R(J,J).GE.@.0) GO TO 22¢ 
IFAULT = 11 
Z = R(J,J) 
CALL ERROR(IFAULT, J, 2) 

22@ CONTINUE 
RETURN 
END 
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2946 
2950 
2960 
2970 
2980 
299¢ 
3000 
3016 
3020 
3030 
30640 
3050 
3060 
3070 
3080 
3096 
31060 
3110 
3120 
3130 
3140 
3150 
3160 
3176 
318¢ 
3190 
3200 
3219 
3226 
3236 
3240 
325 
3260 
3270 
3286 
3290 
3300 
3310 
3320 
3330 
3346 
3350 
3360 
3370 
3386 
339¢ 
3400 
3410 
3426 
3430 
3440 
34506 
3460 
3476 
3486 
3490 
3500 
35106 
3520 
3530 
3540 
3550 
3560 
3570 
3580 
3596 
3600 
3616 
3620 
3630 
3640 
3650 
3660 
3670 
3680 
3690 
3706 
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COLLECTED ALGORITHMS (cont.) 


SUBROUTINE L2B(M, N, Ml, L, A, B, W, TOL, MM, NN, MMPNN, 

* Nl, IPIVOT, X, RES, QR, C, IFAULT) 
*k PURPOSE ** 
SUBROUTINE L2B COMPUTES LEAST SQUARES SOLUTIONS TO OVERDETERMINED 
AND UNDERDETERMINED SYSTEMS OF LINEAR EQUATIONS. THE METHOD USED IS 
A MODIFIED GRAM-SCHMIDT ORTHOGONAL DECOMPOSITION WITH ITERATIVE 
REFINEMENT OF THE SOLUTION. THE SOLUTION MAY BE SUBJECT TO LINEAR 
EQUALITY CONSTRAINTS. OUTPUT INCLUDES THE LEAST SQUARES 
COEFFICIENTS, RESIDUALS, UNSCALED COVARIANCE MATRIX, AND INFORMATION 
ON THE BEHAVIOR OF THE ITERATIVE REFINEMENT PROCEDURE. 
MATRIX A IS THE GIVEN MATRIX OF A SYSTEM OF M LINEAR EQUATIONS IN N 


AN NAADDADADAAANQAAQAAANQANQANDQANAAQANANANQAAANAAAAANQANQANMNANQANDANQANANQANDQADANQAAANAAAAAAAARAAARAANRNAARAaAIaANANAAaAANN 


UNKNOWNS, AND MATRIX W IS A GIVEN DIAGONAL MATRIX OF WEIGHTS WITH ALL 


DIAGONAL ELEMENTS NONNEGATIVE. LET H = (SQRT(W))*A. 
IN THE EVENT THAT N1 (THE COMPUTED RANK OF MATRIX H) IS LESS THAN N 


(THE NUMBER OF UNKNOWN COEFFICIENTS), A UNIQUE SOLUTION VECTOR HAVING 


N ELEMENTS CAN BE OBTAINED BY IMPOSING THE CONDITION THAT THE 
SOLUTION BE OF MINIMAL EUCLIDEAN NORM. SUCH A SOLUTION IS SOUGHT IN 
THE CASE OF UNDERDETERMINED OR RANK-DEFICIENT PROBLEMS. 


**k INPUT VARIABLES ** 


M 
N 
M1 
L 
A 


TOL 


NN 


MMPNN 


TOTAL NUMBER OF EQUATIONS. 

NUMBER OF UNKNOWN COEFFICIENTS. 

NUMBER OF LINEAR CONSTRAINTS (@.LE.M1.LE.M AND M1.LE.N). 

NUMBER OF RIGHT-HAND SIDES (VECTORS OF OBSERVATIONS). 

TWO-DIMENSIONAL ARRAY OF SIZE (MM,N). ON ENTRY, THE ARRAY A 

CONTAINS THE GIVEN MATRIX OF A SYSTEM OF M LINEAR EQUATIONS 

IN N UNKNOWNS, WHERE THE FIRST M1 EQUATIONS ARE TO BE 

SATISFIED EXACTLY. A IS LEFT INTACT ON EXIT. 

TWO-DIMENSIONAL ARRAY OF SIZE (MM,L). ON ENTRY, B CONTAINS 

THE L GIVEN RIGHT-HAND SIDES (VECTORS OF OBSERVATIONS). B IS 

LEFT INTACT ON EXIT. 

VECTOR OF SIZE M. ON ENTRY, W CONTAINS THE DIAGONAL ELEMENTS 

OF A GIVEN DIAGONAL MATRIX OF WEIGHTS, ALL NONNEGATIVE. 

(THE FIRST Ml ELEMENTS OF W ARE SET EQUAL TO 1.@ BY THE 

PROGRAM WHEN Ml IS GREATER THAN ZERO.) ON EXIT, THE ORIGINAL 

ELEMENTS OF W HAVE BEEN REPLACED BY THEIR SQUARE ROOTS. 

PARAMETER USED IN DETERMINING THE RANK OF MATRIX H. 

NOTE -- 

(1) IF TOL EQUALS ZERO, THE TOLERANCE USED IN SUBROUTINE 
DECOM2 WILL BE BASED ON MACHINE PRECISION. 

(2) IF TOL IS GREATER THAN ZERO, THIS VALUE OF TOL WILL BE 
USED IN SETTING AN ABSOLUTE TOLERANCE FOR COMPARISON WITH 
DIAGONAL ELEMENTS OF THE TRIANGULAR MATRIX OBTAINED IN 
SUBROUTINE DECOM2. THE VALUE OF TOL CAN BE BASED ON 
KNOWLEDGE CONCERNING THE ACCURACY OF THE DATA. 

DIMENSIONING PARAMETER SPECIFYING MAXIMUM NUMBER OF ROWS IN 

THE ARRAYS A, B AND RES. MM MUST SATISFY MM.GE.M. 

DIMENSIONING PARAMETER SPECIFYING MAXIMUM NUMBER OF ROWS IN 

THE ARRAY X. NN MUST SATISFY NN.GE.N. 

DIMENSIONING PARAMETER SPECIFYING MAXIMUM NUMBER OF ROWS IN 

THE ARRAY QR. MMPNN MUST SATISFY MMPNN.GE.M+N. 


**& QUTPUT VARIABLES AND INTERNAL VARIABLES ** 


N1 


COMPUTED RANK OF MATRIX H, WHERE H = (SQRT(W))*A. 


IPIVOT VECTOR OF SIZE N. ON EXIT, THIS ARRAY RECORDS THE ORDER 


IN WHICH THE COLUMNS OF H WERE SELECTED BY THE PIVOTING 
SCHEME IN THE COURSE OF THE ORTHOGONAL DECOMPOSITION. 
WHENEVER N1.LT.N, THE FIRST Nl ELEMENTS OF IPIVOT INDICATE 
WHICH COLUMNS OF H WERE FOUND TO BE LINEARLY INDEPENDENT. 
TWO-DIMENSIONAL ARRAY OF SIZE (NN,L). ON EXIT, X CONTAINS 
THE SOLUTION VECTORS. 
TWO-DIMENSIONAL ARRAY OF SIZE (MM,L). ON EXIT, RES CONTAINS 
THE RESIDUAL VECTORS. 
TWO-DIMENSIONAL ARRAY OF SIZE (MMPNN,N). ON EXIT, QR 
CONTAINS THE LOWER TRIANGULAR PORTION OF THE SYMMETRIC 
UNSCALED COVARIANCE MATRIX. (THIS ARRAY IS USED INTERNALLY 
TO STORE RESULTS FROM SUBROUTINE DECOM2 WHICH ARE 
DESTROYED IN COMPUTING THE COVARIANCE MATRIX.) 
VECTOR HAVING AT LEAST 6* (M+N)+2*L ELEMENTS USED (1) FOR 
INTERNAL WORK SPACE AND (2) FOR RETURNING INFORMATION ON THE 
BEHAVIOR OF THE ITERATIVE REFINEMENT PROCEDURE. 
(A) NUMIT IS THE NUMBER OF ITERATIONS CARRIED OUT DURING THE 
ITERATIVE REFINEMENT IN ATTEMPTING TO OBTAIN A SOLUTION 
FOR THE K-TH RIGHT-HAND SIDE. 
ON EXIT, C(K) = +NUMIT IF THE SOLUTION CONVERGED, AND 
C(K) 


-NUMIT IF THE SOLUTION FAILED TO CONVERGE. 
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COLLECTED ALGORITHMS (cont.) 
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i 
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(B) DIGITX GIVES AN ESTIMATE OF THE NUMBER OF CORRECT DIGITS 
IN THE INITIAL SOLUTION OF THE COEFFICIENTS FOR THE K-TH 
RIGHT-HAND SIDE. ON EXIT, C(K+L) = DIGITX. 

IFAULT FAULT INDICATOR WHICH IS ZERO IF NO ERRORS WERE ENCOUNTERED 
AND POSITIVE IF ERRORS WERE DETECTED OR IF EVIDENCE OF SEVERE 
ILL-CONDITIONING WAS FOUND. DIAGNOSTIC MESSAGES ARE PRINTED 
FROM SUBROUTINE ERROR. IF IFAULT IS SET EQUAL TO l, 2, 3, 4, 
5, 6 OR 7, EXECUTION IS TERMINATED. EXECUTION CONTINUES WHEN 
IFAULT IS SET EQUAL TO 8, 9 OR 1@ PROVIDED THAT A SOLUTION 
WAS OBTAINED FOR AT LEAST ONE RIGHT-HAND SIDE. THE VALUE OF 
IFAULT IS USED TO INDICATE THE FOLLOWING -- 

= NO ERRORS ENCOUNTERED. 

BAD INPUT PARAMETER (M, N OR L). 

BAD INPUT PARAMETER (M1). 

BAD DIMENSION. EITHER M.GT.MM, N.GT.NN OR MtN.GT.MMPNN. 

AT LEAST ONE WEIGHT IS NEGATIVE. 

EITHER MATRIX H OR MATRIX OF CONSTRAINTS EQUALS ZERO. 

CONSTRAINTS ARE LINEARLY DEPENDENT. 

ALL SOLUTIONS FAILED TO CONVERGE. 

SOLUTION FAILED TO CONVERGE FOR AT LEAST ONE RIGHT-HAND 

SIDE. 

= LARGE NUMBER OF ITERATIONS REQUIRED FOR CONVERGENCE. 

ESTIMATED NUMBER OF DIGITS IN INITIAL SOLUTION OF 

COEFFICIENTS IS SMALL. 

11 = DIAGONAL ELEMENT OF COVARIANCE MATRIX WAS COMPUTED TO BE 

NEGATIVE OWING TO ROUNDING ERROR. 


aSAnNADUPWNHE GS 
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** SUBROUTINES REQUIRED ** 
SUBROUTINE DECOM2 
USES MODIFIED GRAM-SCHMIDT ALGORITHM WITH PIVOTING TO 
OBTAIN AN ORTHOGONAL DECOMPOSITION OF THE INPUT MATRIX. 
SUBROUTINE SOLVE2 
COMPUTES COEFFICIENTS AND RESIDUALS. ITERATIVE REFINEMENT IS 
USED TO IMPROVE THE ACCURACY OF THE INITIAL SOLUTION. 
SUBROUTINE SOLVE3 
CALLED ONLY BY SUBROUTINE SOLVE2. 
SUBROUTINE COVAR 
COMPUTES UNSCALED COVARIANCE MATRIX OF THE COEFFICIENTS. 
SUBROUTINE ERROR 
PRINTS ERROR DIAGNOSTICS WHEN ERRORS ARE DETECTED OR WHEN 
EVIDENCE OF SEVERE ILL-CONDITIONING IS FOUND. 


** STORAGE REQUIREMENTS ** 

THE STORAGE REQUIRED FOR THE DIMENSIONED ARRAYS IN SUBROUTINE L2B IS 
M*(24N + 2*L + 7) + N¥(N + L + 7) + 2*L 

LOCATIONS. ALL ARRAYS REQUIRED IN SUBROUTINES CALLED BY L2B ARE 

DECLARED HEREIN AND ARE TRANSMITTED ONLY “THROUGH PARAMETER LISTS OF 

CALL-SEQUENCES . 


** PRECISION OF ARITHMETIC CALCULATIONS ** 

SINGLE PRECISION ARITHMETIC IS USED FOR ALL CALCULATIONS EXCEPT THE 
DOUBLE PRECISION ACCUMULATION OF INNER PRODUCTS. (THE VARIABLE SUM 
IS DECLARED TO BE DOUBLE PRECISION IN SUBROUTINES DECOM2, SOLVE2, 
SOLVE3 AND COVAR.) IT IS ESSENTIAL FOR THE SUCCESS OF THE ITERATIVE 
REFINEMENT PROCEDURE THAT INNER PRODUCTS BE ACCUMULATED IN DOUBLE 
PRECISION. 


** CONVERSION OF THE PROGRAM TO DOUBLE PRECISION ** 
HKAKKKEREREREERERER EER RERERERERRER ERE RK ER ER ER ER RE RE RRR RREREREEREREREE 
* ON COMPUTERS HAVING SHORT WORD LENGTH (AS THE IBM 360/370) IT MAY * 
* BE DESIRABLE TO PERFORM ALL CALCULATIONS IN DOUBLE PRECISION. IN * 
THIS CASE, THE ITERATIVE REFINEMENT PRESENTLY INCLUDED IN SOLVE2 
SHOULD BE OMITTED. 

TO CONVERT THE PROGRAM TO DOUBLE PRECISION, THE FOLLOWING 

APPROACH IS SUGGESTED. 


* 
k 
* 
* 
k 
1. VARIABLES PRESENTLY DECLARED TO BE REAL SHOULI) BE DECLARED * 
DOUBLE PRECISION. THOSE TYPED INTEGER, DOUBLE PRECISION AND * 
LOGICAL SHOULD NOT BE CHANGED. * 

. THE USE OF FAIL, NUMIT AND DIGITX SHOULD BE OMITTED. * 
. DESCRIPTION OF VARIABLE C (AT L2B 696-790) SHOULD READ -- * 
C VECTOR HAVING AT LEAST 6*(M+N) ELEMENTS USED ONLY FOR * 
INTERNAL WORK SPACE. * 

4. THE VALUE OF ETA (AT L2B 1960) SHOULD BE SET $O THAT IT IS THE * 
SMALLEST POSITIVE DOUBLE PRECISION NUMBER SUCH THAT 1.@ + ETA * 

IS GREATER THAN 1.@ IN DOUBLE PRECISION ARITHMETIC. * 
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780 
790 
800 
810 
820 
83¢ 
846 
85¢ 
860 
870 
880 
89¢ 
906 
91¢ 
92¢ 
936 
940 
956 
96¢ 
976 
980 
996 
10066 
1616 
19620 
1930 
1946 
165¢@ 
1660 
1076 
1980 
1699 
11900 
111¢ 
1129 
1130 
1146 
115¢ 
116¢ 
117¢ 
1180 
119¢ 
1266 
1210 
1220 
1236 
1246 
1250 
1260 
127¢ 
128¢ 
1296 
13060 
1316 
1326 
133¢ 
134@ 
1350 
1360 
1370 
1380 
1390 
1400 
1410 
1420 
1436 
1440 
1450 
1460 
147@ 
1480 
149@ 
1506 
151¢ 
1520 
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FOR IBM COMPUTER TYPE, ETA = 16.**(-13) 
FOR UNIVAC COMPUTER TYPE, ETA = 2,**(-59) 
5. THE FOLLOWING FORTRAN FUNCTIONS SHOULD BE CHANGED -- 


SINGLE PRECISION NAME DOUBLE PRECISION NAME 
DBLE (X) xX 
FLOAT (N) DBLE (FLOAT (N) ) 
SQRT (X) DSQRT (X) 
DBLE(X) IS USED IN SUBROUTINES DECOM2, SOLVE2, SOLVE3 AND 
COVAR. 


FLOAT(N) IS USED IN SUBROUTINE DECOM2. 
SQRT(X) IS USED IN SUBROUTINE L2B. 

6. IT MAY BE NECESSARY OR DESIRABLE TO CHANGE CERTAIN FORMATS IN 
SUBROUTINE ERROR, REPLACING G SPECIFICATIONS BY D. 

7. REPLACE STATEMENT L2B 250¢@ BY A STATEMENT READING 

K3 = 1 

8. FURTHER DETAILS ARE GIVEN IN SUBROUTINE SOLVE2 IN CONNECTION 
WITH THE OMISSION OF ITERATIVE REFINEMENT. 

9. IN SUBROUTINE L2B, STATEMENTS L2B 95¢-1000, 1826-183¢, 2620, 
2350-2360, 2486-2496, 3070, 3286-3570 AND 3596-3626 SHOULD BE 
OMITTED. 

STATEMENT NUMBERS GIVEN HERE REFER TO THOSE IN THE RIGHT-HAND 
MARGIN. CERTAIN COMMENTS IN SUBROUTINE L2B DO NOT APPLY TO 
THE DOUBLE PRECISION VERSION. 


Ce ee ee ee ee ee 
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RAEKKEKEREKREKRERERERERERERERERRERERERERERRERERERERERERERRERERERERERRERE 


INTEGER IPIVOT(N) 

REAL A(MM,N), B(MM,L), C(1), ETA, QR(MMPNN,N), 
* RES(MM,L), TOL, W(M), X(NN,L), Z 

REAL DIGITX 

LOGICAL FAIL 

LOGICAL SING 


SET VALUE OF ETA, A MACHINE-DEPENDENT PARAMETER. 

ETA, THE RELATIVE MACHINE PRECISION, IS THE SMALLEST POSITIVE REAL 
NUMBER SUCH THAT 1.@ + ETA IS GREATER THAN 1.¢ IN FLOATING-POINT 
ARITHMETIC. 


FOR IBM COMPUTER TYPE, ETA = 16.**(-5) 

FOR UNIVAC COMPUTER TYPE, ETA = 2.**(-26) 
FOR CDC COMPUTER TYPE, ETA = 2.**(-47) 

FOR HONEYWELL COMPUTER TYPE, ETA = 2.**(-27) 


ETA = 2,.**(-26) 
DEFAULT VALUE FOR TOL IS ZERO. 


IF (TOL.LT.@.@) TOL = 0.0 
IFAULT = @ 
KSUM = @ 


PERFORM INITIAL CHECKING OF INPUT PARAMETERS, DIMENSIONS AND 
WEIGHTS FOR POSSIBLE ERRORS. 


IF (M.GT.@ .AND. N.GT.@ .AND. L.GT.@) GO TO 10 
IFAULT = 1 
CALL ERROR(IFAULT, K, Z) 
RETURN 
19 IF (M1.LE.M .AND. M1.LE.N .AND. M1.GE.@) GO TO 2¢ 
LFAULT = 2 
CALL ERROR(IFAULT, K, Z) 
RETURN 
20 IF (M.LE.MM .AND. N.LE.NN .AND. M+N.LE.MMPNN) GO TO 30 
IFAULT = 3 
K = 2 
CALL ERROR(IFAULT, K, Z) 
RETURN 
3@ DO 4@ I=1,M 
IF (M1.GT.@ .AND. I.LE.M1) W(I) = 1.0 
IF (W(I).GE.@.@6) GO TO 4¢ 
IFAULT = 4 
Z = W(I) 
CALL ERROR(IFAULT, I, Z) 
4@ CONTINUE 
IF (IFAULT.EQ.4) RETURN 
DO 5¢@ I=1,M 
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L2B 
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L2B 
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1530 
1540 
155@ 
1560 
157@ 
1580 
1590 
1600 
1610 
1620 
1630 
1640 
1650 
1660 
1670 
168¢ 
1690 
17066 
1710 
1720 
1730 
1740 
1750 
1760 
1770 
1780 
1790 
1800 
181@ 
1820 
1830 
1840 
1850 
186¢ 
1870 
1886 
1890 
1900 
1919 
1920 
1930 
1940 
1950 
1960 
1970 
1980 
1990 
2000 
2010 
2920 
2630 
2040 
2050 
2960 
20670 
20680 
2690 
2100 
2110 
2120 
2130 
2140 
2150 
2160 
2170 
2180 
2196 
2200 
2210 
2220 
2230 
2240 
2250 
2260 
2270 
2280 
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COLLECTED ALGORITHMS (cont.) 


W(I) = SQRT(W(T)) 
5@ CONTINUE 


SET PARAMETERS WHICH ALLOCATE VECTOR C TO CONTAIN CERTAIN FINAL 


RESULTS AND ALSO TO BE USED AS WORK SPACE. 


Kl IS STARTING POINT FOR 
K2 IS STARTING POINT FOR 
K3 IS STARTING POINT FOR 
K4 IS STARTING POINT FOR 
STARTING POINT FOR 
K6 IS STARTING POINT FOR 
K7 IS STARTING POINT FOR 
K8 IS STARTING POINT FOR 
K9 IS STARTING POINT FOR 


NUMIT AND FAIL, OF LENGTH L. 
DIGITX, OF LENGTH L. 

D, OF LENGTH N. 

K-TH COLUMN OF B, OF LENGTH M. 
K-TH COLUMN OF X, OF LENGTH N. 
K-TH COLUMN OF RES, OF LENGTH M. 
WORK SPACE OF LENGTH M. 

WORK SPACE OF LENGTH M. 

WORK SPACE OF LENGTH N. 


Ki@ IS STARTING POINT FOR WORK SPACE OF LENGTH N. 


K11 IS STARTING POINT FOR WORK SPACE OF LENGTH M + N. 
K12 IS STARTING POINT FOR WORK SPACE OF LENGTH M + N 


qgaaangaananananaanaaanaaann 
ra 
un 
ei 
on 


x 
wn 

tetttetst 

mee AER eOM 


THE LAST N ROWS OF ARRAY 


QaagaaAAA 


DO 6@ I=1,K 
C(L) = 6.¢ 

6@ CONTINUE 
MP1 =M 


7@ CONTINUE 
DO 8¢ I=MP1,MPN 
QR(I,J) = 0.6 
86 CONTINUE 
9¢ CONTINUE 


aaAaAnD 


CALL DECOM2(M, N, Ml, ETA, TOL, QR, C(K3), Nl, IPIVOT, SING, 


* MMPNN) 


. 


MULTIPLY EACH ROW OF MATRIX A (M BY N) BY ITS APPROPRIATE WEIGHT AND 
STORE THE RESULT IN THE FIRST M ROWS OF ARRAY QR. 


QR EQUAL TO ZERO. 


A(I,J)*W(I) 


OBTAIN AN ORTHOGONAL DECOMPOSITION OF THE MATRIX STORED IN THE FIRST 
M ROWS OF ARRAY QR AND COMPUTE ITS RANK. 


SET ARRAY C AND 


aaaAAa 


a 


IF (.NOT.SING) GO TO 11@ 
IF (N1.GT.6) GO TO 1066 


TFAULT = 5 
CALL ERROR(IFAULT, K, Z) 
RETURN 


1¢@ IFAULT = 6 
CALL ERROR(IFAULT, K, Z) 
RETURN 


SEEK A SOLUTION (COEFFICIENTS AND RESIDUALS) FOR EACH OF THE L LEAST 


SQUARES PROBLEMS WHOSE RIGHT-HAND SIDES ARE GIVEN IN THE ARRAY B. 


11@ DO 200 K=1,L 
K-TH RIGHT-HAND SIDE. 
K@ = K4 - 1 
DO 12@ I=1,M 
K@ = KG + 1 
C(K@) = B(I,K) 
126 CONTINUE 
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L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
L2B 
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L2B 
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2290 
2300 
2316 
2320 
233¢ 
2340 
2350 
2360 
2370 
2380 
2390 
2400 
2410 
2420 
2430 
2446 
2450 
246¢ 
2470 
2480 
2490 
2500 
251¢ 
2520 
2530 
2546 
2550 
2560 
2570 
2580 
2590 
2600 
2610 
262¢ 
26306 
2646 
2650 
2660 
2670 
2680 
2690 
2700 
2710 
2720 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
28060 
2810 
2820 
283¢ 
2846 
2850 
2860 
2870 
2880 
2896 
2900 
2916 
2926 
2930 
2940 
2950 
2960 
2976 
2980 
2990 
3000 
3610 
3626 
3030 
3040 
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COLLECTED ALGORITHMS (cont.) 


C 


AAANRAANAAANA 


aqgaagaaana 


CALL SOLVE2(M, N, M1, A, C(K4), W, N1, IPIVOT, QR, C(K3), 
* ETA, FALL, NUMIT, DIGITX, 
* C(K5), C(K6), C(K7), C(K8), C(K9), C(K10), C(K11), C(K12), 
* MM, MMPNN) 


K@ = K5 -1 
DO 13@ J=1,N 
KO = KO +1 
X(J,K) = C(KO) 
13@ CONTINUE 
IF (M1.EQ.9) GO TO 15¢ 
DO 14@ I=1,M1 
RES(I,K) = 0.0 
140 CONTINUE 
15@ MIP1 = Ml +1 
IF (MIP1.GT.M) GO TO 176 
K@ = K6 + M1 - 1 
DO 16@ I=M1P1,M 
K@ = KO +1 
RES(I,K) = C(KQ) 
16@ CONTINUE 
170 CONTINUE 


FOR RIGHT-HAND SIDES WHERE CONVERGENCE OF A SOLUTION IS REPORTED, 
A CHECK IS MADE FOR EVIDENCE OF SEVERE ILL-CONDITIONING. SUCH 


EVIDENCE IS FURNISHED BY LARGE VALUES OF NUMIT (NUMBER OF ITERATIONS 


BEFORE CONVERGENCE WAS OBTAINED) AND SMALL VALUES OF DIGITX 
(ESTIMATE OF THE NUMBER OF CORRECT DIGITS IN THE INITIAL SOLUTION 
OF THE COEFFICIENTS). IF NUMIT EXCEEDS -ALOG1@(ETA) A DIAGNOSTIC 
MESSAGE IS PRINTED TO WARN OF ILL-CONDITIONING. IF DIGITX IS LESS 
THAN @.5 (HALF A DECIMAL DIGIT) A SIMILAR DIAGNOSTIC MESSAGE IS 
PRINTED. 


C(K) = FLOAT (NUMIT) 

IF (FAIL) C(K) = -C(K) 
K@ = K2+K-1 

C(K@) = DIGITX 

IF (.NOT.FAIL) GO TO 18¢ 


KSUM IS A TALLY OF SOLUTIONS WHICH FAILED TO CONVERGE. 
KSUM = KSUM + 1 
IFAULT = 8 
CALL ERROR(IFAULT, K, Z) 
GO TO 2¢6¢ 


186 2Z = -ALOG1@(ETA) 
IF (FLOAT(NUMIT).LE.Z) GO TO 19¢ 
IFAULT = 9 
Z = FLOAT(NUMIT) 
CALL ERROR(IFAULT, K, Z) 
199 IF (DIGITX.GE.@.5) GO TO 20¢ 
IFAULT = 1¢@ 
Z = DIGITX 
CALL ERROR(IFAULT, K, Z) 
260 CONTINUE 
IF (KSUM.LT.L) GO TO 21¢ 


IFAULT = 7 
CALL ERROR(IFAULT, K, Z) 
RETURN 


216 IF (N1.LT.N) RETURN 
DO 23@ I=1,N 
MPI =M+I1 
DO 22 J=1,N 
QR(I,J) = QR(MPI,J) 

226 CONTINUE 

QR(I,I) = 0.0 
236 CONTINUE 


COMPUTE THE UNSCALED COVARIANCE MATRIX OF THE COEFFICIENTS. 
CALL COVAR(N, Ml, Nl, IPIVOT, QR, C(K3), C(K9), MMPNN) 


IN CERTAIN PROBLEMS, SOME DIAGONAL TERMS OF THE UNSCALED COVARIANCE 
MATRIX ARE EQUAL TO ZERO OR TO SMALL POSITIVE NUMBERS. BECAUSE OF 
ROUNDING ERRORS, COMPUTED VALUES FOR THESE TERMS MAY BE SMALL 
NEGATIVE NUMBERS. AN ERROR DIAGNOSTIC IS PRINTED IF ANY DIAGONAL 
TERM IS NEGATIVE. 
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3050 
3960 
3070 
3980 
3990 
3160 
3116 
3129 
313¢ 
3146 
315¢ 
3160 
3170 
318¢ 
3199 
3200 
3210 
3220 
323¢ 
3240 
3250 
3260 
3270 
3286 
3290 
3300 
3310 
332¢ 
3330 
3346 
335 
3366 
3370 
3380 
3390 
3406 
34106 
3420 
3430 
3446 
3450 
3460 
3470 
3480 
3490 
3500 
3510 
3520 
3530 
3540 
3550 
3560 
3570 
3580 
3596 
3606 
3616 
3626 
3630 
3640 
365¢ 
3660 
3676 
3680 
3699 
3700 
371¢ 
3720 
3730 
3740 
3750 
3760 
3770 
3780 
3796 
3860 
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COLLECTED ALGORITHMS (cont.) 


C 


AANMQAANQAAARAAIAAANKNANAANNANAANANNANANAaaAaNnaAannnaaang 


C 


Cc 


DO 24¢ J=1,N 
IF (QR(J,J).GE.@.6) GO TO 24@ 
IFAULT = 11 
Z = QR(J,J) 
CALL ERROR(IFAULT, J, Z) 

240 CONTINUE 
RETURN 
END 


SUBROUTINE DECOM1(...) 

SUBROUTINE DECOM1 USES A MODIFIED GRAM-SCHMIDT ALGORITHM WITH 
PIVOTING TO OBTAIN AN ORTHOGONAL DECOMPOSITION OF THE INPUT MATRIX 
GIVEN IN Q. 

THE INPUT PARAMETER TOL (EQUAL EITHER TO ZERO OR TO A POSITIVE 
NUMBER) IS USED IN DETERMINING THE RANK OF MATRIX Q. 

NOTE -- 

(1) IF TOL EQUALS ZERO, THE TOLERANCE USED AT STATEMENT DC1 1080 
WILL BE BASED ON MACHINE PRECISION. 

UNDER THIS APPROACH, THE TOLERANCE (TOL2) IS SET EQUAL TO 
(FLOAT (N) *ETA) **2*D(M1+1) AT STATEMENT DC1. 1070. 

IF DESIRED, THE USER CAN OBTAIN A MORE CONSERVATIVE 
TOLERANCE BY REPLACING N IN THIS STATEMENT BY A LARGER 
QUANTITY. 

(2) IF TOL IS GREATER THAN ZERO, TOL2 (EQUAL TO THE SQUARE OF 
TOL) WILL BE USED AT STATEMENT DC1 10680 AS AN ABSOLUTE 
TOLERANCE FOR COMPARISON WITH DIAGONAL ELEMENTS OF THE 
TRIANGULAR MATRIX OBTAINED IN THE DECOMPOSITION. UNDER THIS 
APPROACH, THE VALUE OF TOL CAN BE BASED ON KNOWLEDGE 
CONCERNING THE ACCURACY OF THE DATA. 

ON EXIT, THE ARRAYS Q, R, D AND IPIVOT CONTAIN THE RESULTS OF THE 
DECOMPOSITION WHICH ARE NEEDED FOR OBTAINING AN INITIAL SOLUTION 
AND FOR ITERATIVE REFINEMENT. 

ON EXIT, N1 IS THE COMPUTED RANK OF THE INPUT MATRIX Q. 

ON EXIT, SING IS SET EQUAL TO .TRUE. WHENEVER 

(1) Nl = @ (1.E., INPUT MATRIX Q EQUALS ZERO OR MATRIX OF 
CONSTRAINTS EQUALS ZERO), OR 

(2) N1 IS LESS THAN Ml (I.E., THE Ml BY N MATRIX OF LINEAR 
CONSTRAINTS IS SINGULAR). 

OTHERWISE, ON EXIT FROM DECOM1, SING = .FALSE. 
ON EXIT, THE VECTOR IPIVOT RECORDS THE ORDER IN WHICH THE COLUMNS 
OF Q WERE SELECTED BY THE PIVOTING SCHEME IN THE COURSE OF THE 
ORTHOGONAL DECOMPOSITION. 
SUBROUTINE DECOM1(M, N, Ml, ETA, TOL, Q, R, D, Nl, IPIVOT, SING, 
* MM, NN) 

INTEGER IPIVOT(N) 

REAL C, D(1), DM, DS, ETA, Q(MM,N), R(NN,N), RSJ, TOL, TOL2 

DOUBLE PRECISION SUM 

LOGICAL FSUM, SING 

Nl = @ 

SING 

FSUM 

MV = 

MH = M1 

LF (TOL.GT.6.@) TOL2 = TOL**2 

DO 1@ J=1,N 

D(J) = 0.0 
IPIVOT(J) = J 

1@ CONTINUE 

STEP NUMBER NS OF THE DECOMPOSITION. 
DO 21@ NS=1,N 

NSM1 = NS - 1 
NSP1 = NS +1 
IF (NS.EQ.M1+1) GO TO 2 
GO TO 3¢ 

2@ IF (M1.EQ.M) GO TO 15¢ 
MV = M1 +1 
MH = M 
FSUM = .TRUE. 


. TRUE. 
. TRUE. 


ew il 


PIVOT SEARCH. 
36 «=6DS = @.¢ 
NP = NS 


DO 8@ J=NS,N 
IK = IPIVOT(J) 
LF (FSUM) GO TO 4¢ 
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COLLECTED ALGORITHMS (cont.) 


GO TO 6¢ 
4¢ SUM = $9.0 
DO 5@ L=MV,MH 


SUM = SUM + DBLE(Q(L, IK) ) *DBLE(Q(L,IK)) 


50 CONTINUE 
D(J) = SUM 

60 IF (DS.LT.D(J)) GO TO 7¢ 
GO TO 8¢@ 

7@ DS = D(J) 
NP = J 


86 CONTINUE 
C END PIVOT SEARCH. 
IK = IPIVOT(NP) 
IF (FSUM) DM = DS 
IF (DS.LT.ETA*DM) GO TO 9¢ 
FSUM = .FALSE. 
GO TO 1¢0 
99 FSUM = .TRUE. 
16¢ IF (FSUM) GO TO 3¢ 
IF (NP.NE.NS) GO TO 110 
GO TO 130 
C COLUMN INTERCHANGE. 
11¢  IPIVOT(NP) = IPIVOT(NS) 
IPIVOT(NS) = IK 
D(NP) = D(NS) 
IF (NS.EQ.1) GO TO 13 
DO 12@ L=1,NSM1 


C = R(L,NP) 
R(L,NP) = R(L,NS) 
R(L,NS) =C€ 


12@ CONTINUE 
C END COLUMN INTERCHANGE. 


C RETURN HERE IF N1 = @. EITHER INPUT MATRIX Q EQUALS ZERO OR MATRIX 


C OF CONSTRAINTS EQUALS ZERO. 
136 IF (NS.EQ.1 .AND. DS.EQ.6.@) RETURN 
SUM = @.¢@ 
DO 146 L=MV,MH 


SUM = SUM + DBLE(Q(L,IK))*DBLE(Q(L,IK)) 


146 CONTINUE 
D(NS) = SUM 
DS = D(NS) 


IF (TOL.EQ.¢.0) TOL2 = (FLOAT (N)*ETA)**2*D (M141) 
IF (NS.GT.M1l .AND. DS.LE.TOL2) GO TO 15¢@ 


GO TO 16¢ 
15@ SING = .FALSE. 
C RETURN HERE IF N1.LT.N, N1.GT.@ AND N1.GE.M1. 
RETURN 


C RETURN HERE IF MATRIX OF CONSTRAINTS IS FOUND TO BE SINGULAR. 


166 IF (DS.EQ.¢.6) RETURN 
IF (NSP1.GT.N) GO TO 266 
C BEGIN ORTHOGONALIZATION. 
DO 199 J=NSP1,N 
NP = IPIVOT(J) 
SUM = 9.0 
DO 17¢ L=MV,MH 


170 CONTINUE 
RSJ = SUM 
RSJ = RSJ/DS 


R(NS,J) = RSJ 
DO 18¢ L=MV,M 
Q(L,NP) = Q(L,NP) - RSJ*Q(L,IK) 
18¢ CONTINUE | 
D(J) = D(J) - DS*RSJ*RSJ 
199 CONTINUE 
C END ORTHOGONALIZATION. 
2006 Nl=NI+1 
21 CONTINUE 
C END STEP NUMBER NS. 
SING = .FALSE. 
C NORMAL RETURN. Nl = N. 
RETURN 
END 


SUM = SUM + DBLE(Q(L,NP) )*DBLE(Q(L, IK) ) 
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COLLECTED ALGORITHMS (cont.) 


AaAQaAAANRNAaNAaANaNANnNnNNnNnanNnannnnaanananaanaann 


C 


C 


SUBROUTINE DECOM2(...) 
SUBROUTINE DECOM2 USES A MODIFIED GRAM-SCHMIDT ALGORITHM WITH 
PIVOTING TO OBTAIN AN ORTHOGONAL DECOMPOSITION OF THE INPUT MATRIX 
GIVEN IN QR. 
THE INPUT PARAMETER TOL (EQUAL EITHER TO ZERO OR TO A POSITIVE 
NUMBER) IS USED IN DETERMINING THE RANK OF MATRIX QR. 
NOTE -- 


(1) IF TOL EQUALS ZERO, THE TOLERANCE USED AT STATEMENT DC2 118¢ 


WILL BE BASED ON MACHINE PRECISION. 
UNDER THIS APPROACH, THE TOLERANCE (TOL2) LS SET EQUAL TO 
(FLOAT (N) ETA) **2*D (M1+1) AT STATEMENT DC2 1170. 
IF DESIRED, THE USER CAN OBTAIN A MORE CONSERVATIVE 
TOLERANCE BY REPLACING N IN THIS STATEMENT BY A LARGER 
QUANTITY. 

(2) IF TOL IS GREATER THAN ZERO, TOL2 (EQUAL TO THE SQUARE OF 
TOL) WILL BE USED AT STATEMENT DC2 118@ AS AN ABSOLUTE 
TOLERANCE FOR COMPARISON WITH DIAGONAL ELEMENTS OF THE 


TRIANGULAR MATRIX OBTAINED IN THE DECOMPOSITION. UNDER THIS 


APPROACH, THE VALUE OF TOL CAN BE BASED ON KNOWLEDGE 
CONCERNING THE ACCURACY OF THE DATA. 
ON EXIT, THE ARRAYS QR, D AND IPIVOT CONTAIN THE RESULTS OF THE 
DECOMPOSITION WHICH ARE NEEDED FOR OBTAINING AN INITIAL SOLUTION 
AND FOR ITERATIVE REFINEMENT. 
ON EXIT, Nl IS THE COMPUTED RANK OF THE INPUT MATRIX QR. 
ON EXIT, SING IS SET EQUAL TO .TRUE. WHENEVER 
(1) Nl = @ (I.E., INPUT MATRIX QR EQUALS ZERO OR MATRIX OF 
CONSTRAINTS EQUALS ZERO), OR 
(2) N1 IS LESS THAN Ml (I.E., THE Ml BY N MATRIX OF LINEAR 
CONSTRAINTS IS SINGULAR). 
OTHERWISE, ON EXIT FROM DECOM2, SING = .FALSE. 
ON EXIT, THE VECTOR IPIVOT RECORDS THE ORDER IN WHICH THE COLUMNS 
OF QR WERE SELECTED BY THE PIVOTING SCHEME IN THE COURSE OF THE 
ORTHOGONAL DECOMPOSITION. 
SUBROUTINE DECOM2(M, N, Ml, ETA, TOL, QR, D, Ni, IPIVOT, SING, 
* MMPNN) 
INTEGER IPIVOT(N) 
REAL C, D(1), DM, DS, ETA, QR(MMPNN,N), RSJ, TOL, TOL2 
DOUBLE PRECISION SUM 
LOGICAL FINIS, FSUM, SING 
N1 = @ 
SING 
FSUM 
MV 
MH 
MS 
MP1 =M+1 
FINIS = .FALSE. 
IF (TOL.GT.@.0) TOL2 = TOL**2 
DO 1¢ J=1,N 
D(J) = 0.6 
IPIVOT(J) = J 
1@ CONTINUE 
STEP NUMBER NS OF THE DECOMPOSITION. 
DO 35¢ NS=1,N 
K = M+ NS 
IF (NS.EQ.M1+1) GO TO 2¢ 
GO TO 3¢ 
26 IF (ML.EQ.M) GO TO 26¢ 
MV = M1 +1 
MH = M 
FSUM = .TRUE. 
3@ IF (.NOT.FINIS) GO TO 4@ 
GO TO 15¢@ 
PIVOT SEARCH. 
46 DS = 6.¢@ 
NP = NS 
DO 9% J=NS,N 
LF (FSUM) GO TO 5¢ 
GO TO 7¢ 
50 SUM = 0.@ 
DO 6¢@ L=MV,MH 
SUM = SUM + DBLE(QR(L,J))*DBLE(QR(L,J)) 


- TRUE. 
- TRUE. 


1 


= Se t 


60 CONTINUE 
D(J) = SUM 

70 IF (DS.LT.D(J)) GO TO 8¢@ 
GO TO 9¢ 
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80 
90 


100 
110 


DS = D(J) 
NP = J 
CONTINUE 


IF (FSUM) DM = DS 

IF (DS.LT.ETA*DM) GO TO 16¢ 
FSUM = .FALSE. 

GO TO 1106 

FSUM = .TRUE. 

IF (FSUM) GO TO 4¢ 

IF (NP.NE.NS) GO TO 12¢ 

GO TO 14 


COLUMN INTERCHANGE. 


12@ 


13¢ 


IK = IPIVOT(NP) 
IPIVOT(NP) = IPIVOT(NS) 
IPIVOT(NS) = IK 
D(NP) = D(NS) 
KM1 = K-1 
DO 13@ L=1,KM1 
C = QR(L,NP) 
QR(L,NP) = QR(L,NS) 
QR(L,NS) = C 
CONTINUE 


END COLUMN INTERCHANGE. 

END PIVOT SEARCH. 

RETURN HERE IF Nl = @. EITHER INPUT MATRIX QR EQUALS ZERO OR 
MATRIX OF CONSTRAINTS EQUALS ZERO. 


140 
15¢ 


160 


170 
180 


199 


200 


210 


22¢ 


230 
240 
250 


260 


276 
28¢ 


IF (NS.EQ.1 .AND. DS.EQ.¢.06) RETURN 
GO TO 16¢ 
MS =K~-1 
MH=K=-1 
IF (FINIS) GO TO 17¢ 
C= ¢.¢ 
GO TO 18¢ 
C=1.0 
SUM = DBLE(C) 
DO 19¢ L=MV,MH 
SUM = SUM + DBLE(QR(L,NS) ) *DBLE(QR(L,NS) ) 
CONTINUE 
D(NS) = SUM 
DS = D(NS) 
IF (TOL.EQ.@.0) TOL2 = (FLOAT (N)*ETA) **2*D (M1+1) 


IF (.NOT.FINIS .AND. NS.GT.M1 .AND. DS.LE.TOL2) GO TO 240 


GO TO 29¢ 
FINIS = .TRUE. 
MV=M+41 
DO 28@ NP=NS,N 
IF (1.GT.M1) GO TO 25¢ 
DO 21@ L=1,M1 
QR(L,NP) = ¢.¢ 


CONTINUE 
DO 24@ J=1,M1 
SUM = ¢.0 


DO 226 L=1,M 
SUM = SUM + DBLE(QR(L,J))*DBLE(QR(L,NP) ) 


CONTINUE 
C = SUM 
C = C/D(J) 


DO 236 L=1,M1 
QR(L,NP) = QR(L,NP) - C*QR(L,J) 
CONTINUE 
CONTINUE 
MPN1 = M+ N1 
DO 276 JJ=MP1,MPN1 
J=(M+1)+ (M+N1) - JJ 


SUM = ¢.@ 
DO 260 L=J,MPN1 
LMM = L -M 
SUM = SUM + DBLE(QR(J,LMM) ) *DBLE(QR(L,NP) ) 
CONTINUE 
QR(J,NP) = -—SUM 
CONTINUE 
CONTINUE 
GO TO 15¢ 


RETURN HERE IF MATRIX OF CONSTRAINTS IS FOUND TO BE SINGULAR. 


290 


IF (DS.EQ.@.@) RETURN 
QR(K,NS) = -1.0 
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NSP1 = NS + 1 
IF (NSP1.GT.N) GO TO 346 
BEGIN ORTHOGONALIZATION. 
DO 330 J=NSP1,N 
SUM = 0.0 
DO 30¢@ L=MV,MH 
SUM = SUM + DBLE(QR(L,J))*DBLE(QR(L,NS) ) 
309 CONTINUE 
RSJ = SUM 
RSJ = RSJ/DS 
QR(K,J) = RSJ 
DO 31@ L=1,MS 


QR(L,J) = QR(L,J) - RSJ*QR(L,NS) 
316 CONTINUE 
IF (.NOT.FINIS) GO TO 326 
GO TO 330 
320 D(J) = D(J) — DS*RSI*RSI 


330 CONTINUE 
END ORTHOGONALIZATION. 
340 IF (.NOT.FINIS) Nl = N1 + 1 
35@ CONTINUE 
END STEP NUMBER NS. 
SING = .FALSE. 
NORMAL RETURN. 
RETURN 
END 


SUBROUTINE SOLVE1(...) 
SUBROUTINE SOLVE1 USES THE ORTHOGONAL DECOMPOSITION STORED IN Q, R, 
D AND IPIVOT TO COMPUTE THE SOLUTION (COEFFICIENTS AND RESIDUALS) 
TO THE LEAST SQUARES PROBLEM WHOSE RIGHT-HAND SIDE IS GIVEN IN B. 
IN THE EVENT THAT Nl (THE COMPUTED RANK OF MATRIX H) IS LESS THAN N 
(THE NUMBER OF UNKNOWN COEFFICIENTS), THE ORIGINAL MATRIX H (M BY N) | 
IS REPLACED BY A SMALLER MATRIX (M BY N1) WHOSE COLUMNS ARE LINEARLY 
INDEPENDENT, AND A SOLUTION IS SOUGHT FOR THE SMALLER SYSTEM OF 
EQUATIONS. THUS N - Nl COLUMNS OF THE ORIGINAL MATRIX H ARE DELETED, 
AND COEFFICIENTS CORRESPONDING TO THESE N - Nl DELETED COLUMNS WILL 
BE SET EQUAL TO ZERO. 
IN NORMAL EXITS, THE SOLUTION IS CONTAINED IN THE VECTOR X 
(COEFFICIENTS) AND THE VECTOR RES (RESIDUALS). 
ITERATIVE REFINEMENT IS USED TO IMPROVE THE ACCURACY OF THE INITIAL 
SOLUTION. 
ON EXIT, FAIL IS SET EQUAL TO .TRUE. IF THE SOLUTION FAILS TO 
IMPROVE SUFFICIENTLY. OTHERWISE, FAIL = .FALSE. INFORMATION ON THE 
BEHAVIOR OF THE ITERATIVE REFINEMENT PROCEDURE IS GIVEN BY NUMIT AND 
DIGITX. NUMIT IS THE NUMBER OF ITERATIONS CARRIED OUT IN ATTEMPTING 
TO OBTAIN A SOLUTION. DIGITX IS AN ESTIMATE OF THE NUMBER OF 
CORRECT DIGITS IN THE INITIAL SOLUTION OF THE COEFFICIENTS. 


xkKKAKKKK CONVERSION OF THIS SUBROUTINE TO DOUBLE FRECISION *x*#xx4#% 
IF THE PROGRAM IS CONVERTED SO THAT ALL CALCULATIONS ARE DONE IN * 
DOUBLE PRECISION ARITHMETIC, THE ITERATIVE REFINEMENT PRESENTLY * 
INCLUDED IN SOLVE1] SHOULD BE OMITTED, SINCE THE SUCCESS OF THIS #* 
PROCEDURE DEPENDS ON COMPUTING INNER PRODUCTS IN GREATER k 
PRECISION THAN OTHER CALCULATIONS. * 
SEE COMMENTS IN SUBROUTINE L2A REGARDING CONVERSION TO DOUBLE * 
PRECISION. IN ADDITION, THE FOLLOWING COMMENTS INDICATE HOW TO * 
OMIT THE ITERATIVE REFINEMENT FROM THIS SUBROUTINE. STATEMENT * 
NUMBERS GIVEN HERE REFER TO THOSE IN THE RIGHT-HAND MARGIN. * 
* 
* 
* 
* 
* 
* 
* 
k 
* 


1. IN STATEMENT SV1 48@ CHANGE REAL TO DOUBLE PRECISION. 
2. REPLACE STATEMENT SV1 816 BY A STATEMENT READING 
3@ DO 5@ I=1,M 
3. AFTER STATEMENT SV1 105@ INSERT A STATEMENT READING 
RETURN 
4. OMIT STATEMENTS SV1 14@-219, 45@, 50@-51¢, 53¢-56@, 610, 
680-780, 1600-1780 AND 1860-1860. 


i ee a ee ee 2 
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SUBROUTINE SOLVE1(M, N, Ml, A, B, W, Nl, IPIVOT, Q, R, D, 
* ETA, FAIL, NUMIT, DIGITX, 
* X, RES, F, WRES, G, Y, MM, NN) 

{NTEGER IPIVOT(N) 

REAL A(MM,N), B(1), C, D(1), F(1), G(1), Q(MM,N), 
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* R(NN,N), RES(1), W(M), WRES(1), X(1), Y(1) 


REAL DIGITX, DXNORM, ETA, ETA2, RDR1, RDR2, RDX1, RDX2, RNR, 


* RNX, XNORM 
DOUBLE PRECISION SUM 
LOGICAL FAIL 


NUMIT = @ 

KZ = @ 

ETA2 = ETA*ETA 
DO 1¢ I=1,M 


F(I) = B(I)*W(I) 

WRES(I) = 0.¢@ 

RES(I) = 0.@ 

IF (W(L).EQ.@.@) KZ = KZ +1 
1¢@ CONTINUE 


C BEGIN K-TH ITERATION STEP. 
3@ IF (K.LT.2) GO TO 4@ 


IF (((64.*RDX2.LT.RDX1) .AND. (RDX2.GT.ETA2*RNX)) .OR. 
* ((64.*RDR2.LT.RDR1) .AND. (RDR2.GT.ETA2*RNR))) GO TO 46 


GO TO 30¢ 
4@ RDX1 = RDX2 
RDR1 = RDR2 
RDX2 = ¢.¢ 
RDR2 = @.0 


IF (K.EQ.¢) GO TO 10@ 
C NEW RESIDUALS. 
DO 5@ I=1,M 
WRES(I) = WRES(I) + F(I)*W(I) 
IF (W(I).EQ.¢.6) GO TO 5¢ 
RES(I) = RES(I) + F(I)/W(1) 
5@ CONTINUE 
DO 7¢@ NS=1,N1 
J = IPIVOT(NS) 
X(J) = X(J) + G(NS) 
SUM = 0.0 
DO 6¢ L=1,M 
SUM = SUM + DBLE(A(L,J) )*DBLE (WRES (L) ) 
66 CONTINUE 
G(NS) = -SUM 
7@ CONTINUE 
DO 9@ I=1,M 
SUM = 9.0 
IF (I.GT.M1) SUM = DBLE(RES(I)) 
DO 8¢@ L=1,N 
SUM = SUM + DBLE(A(I,L))*DBLE(X(L)) 
86 CONTINUE 
SUM = SUM - DBLE(B(1)) 
F(L) = -SUM 
F(I) = F(1)*W(1) 
IF (W(1).EQ.@.@) RES(I) = DBLE(RES(I)) - SUM 
96 CONTINUE 
C END NEW RESIDUALS. 
169 MV = 1 
MH = M1 
DO 16¢@ NS=1,N1 
J = IPIVOT(NS) 
IF (NS.NE.M1+1) GO TO 11¢ 
MV = ML +1 
MH = M 
11@ NSML=NS - 1 
SUM = -DBLE(G(NS) ) 
IF (1.GT.NSML) GO TO 13¢ 
DO 12¢ L=1,NSM1 
SUM = SUM + DBLE(R(L,NS) )*DBLE(Y (L) ) 
12@ CONTINUE 
13@ Y(NS) = -SUM 
C = 0.6 
IF (NS.GT.M1) C = -Y(NS) 
SUM = DBLE(C) 
DO 14¢ L=MV,MH 
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SUM = SUM + DBLE(Q(L,J))*DBLE(F(L)) 
14@ CONTINUE 


C = SUM 
C = C/D(NS) 
G(NS) = C 


DO 15@ I=MV,M 
F(1) = F(I) - C*Q(I,J) 
15@ CONTINUE 
16@ CONTINUE 
IF (1.GT.M1) GO TO 21¢ 
DO 17@ I=1,M1 
F(L) = 6.¢ 
17@ CONTINUE 
DO 24% NS=1,M1 
J = IPIVOT(NS) 
SUM = -DBLE(Y(NS)) 
DO 18¢ L=1,M 
SUM = SUM + DBLE(Q(L,J))*DBLE(F(L)) 
18@ CONTINUE 
C = SUM 
C = C/D(NS) 
DO 19¢ I=1,M1 
F(I) = F(I) - C*Q(I,J) 
19¢ CONTINUE 
20¢ CONTINUE 
21¢ DO 246 I=1,N1 
NS = Nl1+1-I1 
NSP1 = NS +1 
SUM = -DBLE(G(NS)) 
IF (NSP1.GT.N1) GO TO 23@ 
DO 22@ L=NSP1,N1 
SUM = SUM + DBLE(R(NS,L) ) *DBLE(G(L)) 
220 CONTINUE 
236 G(NS) = -SUM 
24@ CONTINUE 
DO 25¢ NS=1,N1 
RDX2 = RDX2 + G(NS)*G(NS) 
25@ CONTINUE 
DO 260 I=1,M 
RDR2 = RDR2 + F(IL)*F(1) 
26@ CONTINUE 
IF (K.NE.@) GO TO 27@ 
RNX = RDX2 
RNR = RDR2 
270 IF (K.NE.1) GO TO 296 
XNORM = SQRT(RNX) 
DXNORM = SQRT(RDX2) 
IF (XNORM.NE.@.0@) GO TO 28¢ 
DIGITX = -ALOG1@(ETA) 
GO TO 2990 
28@ DIGITX = -ALOG1@(AMAX] (DXNORM/XNORM, ETA) ) 


C END K-TH ITERATION STEP. 


AANIANQANQNAAAN 


29@ NUMIT = K 
K=K+1 
GO TO 306 
300 IF ((M1+KZ.EQ.M) .AND. (RDX2.GT.4.*ETA2*RNX)) GO TO 31 
IF ((RDR2.GT.4.*ETA2*RNR) .AND. 
* (RDX2.GT.4.*ETA2*RNX)) GO TO 310 
FAIL = .FALSE. 
RETURN 
31@ FAIL = .TRUE. 
RETURN 
END 


SUBROUTINE SOLVE2(...) 


SUBROUTINE SOLVE2 USES THE ORTHOGONAL DECOMPOSITION STORED IN QR, D 
AND IPIVOT TO COMPUTE THE SOLUTION (COEFFICIENTS AND RESIDUALS) 

TO THE LEAST SQUARES PROBLEM WHOSE RIGHT-HAND SIDE IS GIVEN IN B. 

IN THE EVENT THAT N1 (THE COMPUTED RANK OF MATRIX H) IS LESS THAN N 
(THE NUMBER OF UNKNOWN COEFFICIENTS), A UNIQUE SOLUTION VECTOR HAVING 
N ELEMENTS CAN BE OBTAINED BY IMPOSING THE CONDITION THAT THE 
SOLUTION BE OF MINIMAL EUCLIDEAN NORM. SUCH A SOLUTION IS SOUGHT IN 


THE CASE OF UNDERDETERMINED OR RANK-DEFICIENT PROBLEMS. 
IN NORMAL EXITS, THE SOLUTION IS CONTAINED IN THE VECTOR X 
(COEFFICIENTS) AND THE VECTOR RES (RESIDUALS). 
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C ITERATIVE REFINEMENT IS USED TO IMPROVE THE ACCURACY OF THE INITIAL 


C SOL 


C ON EXIT, FAIL IS SET EQUAL TO .TRUE. IF THE SOLUTION FAILS TO 
OTHERWISE, FAIL = .FALSE. 
C BEHAVIOR OF THE ITERATIVE REFINEMENT PROCEDURE IS GIVEN BY NUMIT AND 
ITX. NUMIT IS THE NUMBER OF ITERATIONS CARRIED OUT IN ATTEMPTING 
OBTAIN A SOLUTION. DIGITX IS AN ESTIMATE OF THE NUMBER OF 


C IMP 


C DIG 
C TO 


UTION. 


ROVE SUFFICIENTLY. 


C CORRECT DIGITS IN THE INITIAL SOLUTION OF THE COEFFICIENTS. 
C THIS SUBROUTINE CALLS SUBROUTINE SOLVE3. 


P 


AM AANQAAAARAAARAAARAAAAAARANAAANA 
Le i ed 


1¢ 


20 


1. 
2. 


3. 


4. 


RECISION. 


OMIT THE ITERATIVE REFINEMENT FROM THIS SUBROUTINE. 
NUMBERS GIVEN HERE REFER TO THOSE IN THE RIGHT-HAND MARGIN. 


IN STATEMENT SV2 47 
36 DO 5@ I=1,M 


RETURN 


CHANGE REAL TO DOUBLE PRECISION. 


REPLACE STATEMENT SV2 88¢@ BY.A STATEMENT READING 
REPLACE STATEMENTS SV2 1316-1460 BY A STATEMENT READING 


OMIT STATEMENTS SV2 120-199, 446, 490-500, 520-550, 650, 


759-850, 165¢-18306 AND 185@-191¢. 


SUBROUTINE SOLVE2(M, N, M1, A, B, W, Nl, IPIVOT, QR, D, 
* ETA, FAIL, NUMIT, DIGITX, 


* X, RES, WRES, Yl, Y2 
INTEGER IPIVOT(N) 
REAL A(MM,N), B(1), C 


* RNX, XNORM 
DOUBLE PRECISION SUM 
LOGICAL FAIL _ 
NUMIT = @ 
KZ = @ 
ETA2 = ETA*ETA 
MP1 =M+1 
MPN = M+N 
NIPL = N1 +1 
DO 16 I=1,M 
F(I) = BC(I)*W(1) 
G(I) = 6.¢ 
WRES (I) = ¢.@ 
RES(L) = @.@ 
Y1(I) = ¢.@ 
IF (W(L).EQ.@.@) KZ 
CONTINUE 
DO 2@ NS=1,N 
J=M+NS 


K = 9 


0.9 


» Y, F, G, MM, MMPNN) 


» D(1), F(1), G1), 
* QR(MMPNN,N), RES(1), W(M), WRES(1), X(1), Y(1), Y1(1), Y2(1) 
REAL DIGITX, DXNORM, ETA, ETA2, RDR1, RDR2, RDX1, RDX2, RNR, 


=KZ+1 


C BEGIN K-TH ITERATION STEP. 


3 


IF (K.LT.2) GO TO 4@ 


IF (((64.*RDX2.LT.RDX1) .AND. (RDX2.GT.ETA2*RNX)) .OR. 


* ((64.*RDR2.LT.RDR1) 


GO TO 27¢ 
4@ RDX1 = RDX2 
RDR1 = RDR2 
RDX2 = ¢.¢ 
RDR2 = @.¢@ 


IF (K.EQ.@) GO TO 16¢ 


C NEW RESIDUALS. 


-AND. (RDR2.GT.ETA2*RNR))) GO TO 4¢@ 


INFORMATION ON THE 


RRRKKKKKK CONVERSION OF THIS SUBROUTINE TO DOUBLE PRECISION ****ek4xx 
IF THE PROGRAM IS CONVERTED SO THAT ALL CALCULATIONS ARE DONE IN 
DOUBLE PRECISION ARITHMETIC, THE ITERATIVE REFINEMENT PRESENTLY 
INCLUDED IN SOLVE2 SHOULD BE OMITTED, SINCE THE SUCCESS OF THIS 
PROCEDURE DEPENDS ON COMPUTING INNER PRODUCTS IN GREATER 
PRECISION THAN OTHER CALCULATIONS. 

SEE COMMENTS IN SUBROUTINE L2B REGARDING CONVERSION TO DOUBLE 
IN ADDITION, THE FOLLOWING COMMENTS INDICATE HOW TO 
STATEMENT 
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* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
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* 
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DO 5@ I=1,M SV2 880 
WRES(L) = WRES(I) + F(1)*W(I) SV2 89¢ 

IF (W(I).EQ.@.@6) GO TO 5¢@ §V2 «960 
RES(I) = RES(I) + F(I)/W(1) SV2 910 

Y1(1) = Y1(1) + G(1) SV2 92¢ 

5@ CONTINUE SV2 93¢ 
DO 160 NS=1,N SV2 946 
J=M+NS SV2 95¢@ 

NP = IPIVOT(NS) SV2 960 

X(NP) = X(NP) + F(J) SV2 97¢ 
Y2(NP) = Y2(NP) + G(J) SV2 98¢ 

SUM = -DBLE(X(NP)) SV2 99¢ 

DO 6@ L=1,M SV2 1600 

SUM = SUM + DBLE(A(L,NP) ) *DBLE(Y1(L) ) SV2 1010 

6@ CONTINUE SV2 102@ 
G(J) = -SUM SV2 1630 

LF (NS.GT.N1) GO TO 7@ SV2 1046 

GO TO 8¢ SV2 1650 

7@ =F) = 0.6 SV2 106¢ 
GO TO 16¢ SV2 1070 

86 SUM = @.@ SV2 108¢ 
DO 9¢ L=1,M SV2 109¢ 

SUM = SUM + DBLE(A(L,NP)) *DBLE(WRES (L) ) SV2 11060 

90 CONTINUE SV2 11106 
F(J) = -SUM SV2 112¢ 

19@ CONTINUE SV2 1130 
DO 13¢ I=1,M SV2 114¢ 
SUM = @.0@ SV2 115¢ 

IF (1.GT.M1) SUM = DBLE(RES(I)) SV2 11606 

DO 11¢ L=1,N SV2 1170 

SUM = SUM + DBLE(A(I,L))*DBLE(X(L) ) SV2 1186 

11@ CONTINUE SV2 1196 
SUM = SUM - DBLE(B(I)) SV2 12066 

F(I) = -SUM SV2 12106 

F(L) = F(1)*W(1) SV2 1220 

IF (W(L).EQ.@.@) RES(I) = DBLE(RES(I)) - SUM SV2 1236 

SUM = 0.@ SV2 1246 

IF (1.GT.M1) SUM = DBLE(Y1(I)) SV2 125¢ 

DO 12¢@ L=1,N SV2 1264 

SUM = SUM + DBLE(A(I,L))*DBLE(Y2(L)) SV2 1276 

12@ CONTINUE SV2 128¢ 
G(L) = -SUM SV2 1296 

13@ CONTINUE SV2 1306@ 
IF (N1IP1.GT.N) GO TO 16¢ SV2 1310 

DO 15@ I=N1P1,N SV2 1320 

NS =N+NI1P1-I1 SV2 133¢ 
J=M+NS SV2 134¢ 

SUM = 6.¢ SV2 135¢ 

DO 14@ L=1,J SV2 1360 

SUM = SUM + DBLE(QR(L,NS) )*DBLE(G(L)) SV2 1370 

146 CONTINUE SV2 138¢ 
G(J) = SUM SV2 139¢ 

15@ CONTINUE SV2 14060 
C END NEW RESIDUALS. SV2 1410 
Cc SV2 1426 
16@ CALL SOLVE3(F, Ml, M, Nl, QR, D, Y, MMPNN) SV2 1430 
Cc SV2 1446 
IF (NIP1.GT.N) GO TO 260 SV2 145¢ 

DO 19@ NS=N1P1,N SV2 146@ 
J=M+NS SV2 1476 

SUM = DBLE(G(J)) SV2 1486 

DO 17@ L=MP1,J SV2 1496 

SUM = SUM + DBLE(QR(L,NS))*DBLE(F(L)) SV2 1500 

17@ CONTINUE SV2 1510 
C = SUM SV2 1520 

C = C/D(NS) SV2 1536 

DO 18¢ I=1,J SV2 1546 

F(I) = F(I) - C*QR(I,NS) SV2 155¢ 

18@ CONTINUE SV2 156 
19@ CONTINUE SV2 15706 
20% DO 210 J=MP1,MPN SV2 158¢ 
G(J) = 0.0 SV2 1596 

IF (J.LE.M+N1) G(J) = G(J) + F(J) SV2 1600 

210 CONTINUE SV2 161¢ 
C SV2 162¢ 


CALL SOLVE3(G, Ml, M, N1, QR, D, Y, MMPNN) SV2 16306 
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C 


226 


230 


240 


250 
C END 
266 


276 IF ((MI+KZ.EQ.M) .AND. (RDX2.GT.4.*ETA2*RNX)) GO TO 28¢ 


286 


DO 22¢ I=1,M 
RDR2 = RDR2 + F(I)*F(I) 
CONTINUE 
DO 23@ I=MP1,MPN 
RDX2 = RDX2 + F(I)*F(L) 
CONTINUE 
IF (K.NE.@) GO TO 24 
RNR = RDR2 
RNX = RDX2 
IF (K.NE.1) GO TO 26¢ 
XNORM = SQRT(RNX) 
DXNORM = SQRT(RDX2) 
IF (XNORM.NE.@.@) GO TO 25 
DIGITX = -ALOG1@(ETA) 
GO TO 26¢ 
DIGITX = -ALOG1@(AMAX1 (DXNORM/XNORM, ETA) ) 
K-TH ITERATION STEP. 
NUMIT = K 
K=K+1 
GO TO 3¢ 


IF ((RDR2.GT.4.*ETA2*RNR) .AND. 


* (RDX2.GT.4.*ETA2*RNX)) GO TO 280 


FAIL = .FALSE. 
RETURN 

FAIL = .TRUE. 
RETURN 

END 


SUBROUTINE SOLVE3(F, Ml, M, N1, QR, D, Y, MMPNN) 
C SUBROUTINE SOLVE3 IS CALLED ONLY BY SUBROUTINE SOLVE2. 


C THIS SUBROUTINE CALCULATES NEW VALUES OF F. 


1¢ 
26 


30 
40 


5@ 
60 
76 


89 


96 
16¢ 


11¢ 


REAL C, D(1), F(1), QR(MMPNN,N1), Y(1) 
DOUBLE PRECISION SUM 
MV = 1 
MH = M1 
DO 16¢ NS=1,N1 
J =M+NS 
IF (NS.EQ.MI1+1) GO TO 1¢ 
GO TO 2¢ 


NS - 1 
SUM = -DBLE(F(J)) 
IF (NS.EQ.1) GO TO 4¢ 
DO 36 L=1,NSML 
MPL = M+ L 
SUM = SUM + DBLE(QR(MPL,NS) )*DBLE(Y (L)) 
CONTINUE 
Y(NS) = -SUM 
IF (NS.GT.M1) GO TO 5¢ 
GO TO 6¢ 
C = -Y(NS) 
GO TO 7¢ 
C = ¢.0 
SUM = DBLE(C) 
DO 86 L=MV,MH 
SUM = SUM + DBLE(QR(L,NS) )*DBLE(F(L)) 
CONTINUE 
Cc = SUM 
Cc = C/D(NS) 
F(J) =C 
DO 9¢ L=MV,M 
F(L) = F(L) - C*QR(L,NS) 
CONTINUE 
CONTINUE 
IF (1.GT.M1) GO TO 1506 
DO 116 L=1,M1 
F(L) = @.@ 
CONTINUE 
DO 14¢ NS=1,M1 
SUM = -DBLE(Y(NS)) 
DO 12@ L=1,M 
SUM = SUM + DBLE(QR(L,NS) )*DBLE(F(L)) 
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12@ CONTINUE SV3 460 

Cc = SUM SV3 4706 

C = C/D(NS) SV3 480 

DO 13@ L=1,M1 SV3 496 

F(L) = F(L) -— C*QR(L,NS) SV3 500 

136 CONTINUE SV3 510 
14@ CONTINUE SV3 526 
15@ DO 17@ NS=1,N1 SV3 530 
J=M+Ni+41-NS SV3 540 

MPN1 = M + N1 SV3 550 

SUM = 0.0 SV3. 56¢@ 

DO 16¢ L=J,MPN1 SV3 576 

LMM = L - M SV3 58¢@ 

SUM = SUM + DBLE(QR(J,LMM) )*DBLE(F(L) ) SV3 590 

16@ CONTINUE SV3 600 
F(J) = -SUM SV3 61¢ 

17@ CONTINUE SV3 620 
RETURN SV3 630 

END SV3 646 
SUBROUTINE COVAR(N, Ml, N1, IPIVOT, C, D, Z, NN) cov 10 

C SUBROUTINE COVAR USES RESULTS FROM THE ORTHOGONAL DECOMPOSITION CoV 20 
C STORED IN C, D AND IPIVOT TO COMPUTE THE UNSCALED COVARIANCE MATRIX COV 3¢ 
C OF THE LEAST SQUARES COEFFICIENTS. COV 4@ 
C ON ENTRY, THE FIRST N ROWS AND THE FIRST N COLUMNS OF C CONTAIN THE COV 50 
C UPPER TRIANGULAR MATRIX OBTAINED FROM THE DECOMPOSITION. THIS INPUT COV 6¢ 
C MATRIX IS DESTROYED IN SUBSEQUENT CALCULATIONS. cov 7¢ 
C ON EXIT, THE LOWER TRIANGULAR PORTION OF THE SYMMETRIC UNSCALED COV 80 
C COVARIANCE MATRIX IS CONTAINED IN COV 9¢ 
Cc c(1,1) CoV 160 
Cc C(2,1) C(2,2) cov 119 
Cc ieee CoV 12¢ 
C C(N,1) C(N,2) ... C(N,N) cov 13¢ 
C IF Nl IS LESS THAN N, ONE OR MORE COLUMNS OF THE MATRIX COV 146 
C H = (SQRT(W))*A WERE REJECTED AS BEING LINEARLY DEPENDENT. WHENEVER COV 150 
C THE K~TH COLUMN OF H WAS SO REJECTED, C(I,J) IS SET EQUAL TO ZERO, COV 16¢ 
C FOR I = K OR J = K, I.GE.J. cov 1706 
INTEGER IPIVOT(N) COV 18¢ 

REAL C(NN,N), D(1), Z2(1) COV 19¢ 
DOUBLE PRECISION SUM cOV 2¢6¢ 

L = NL cov 210 

IF (L.GT.M1) C(L,L) = 1.@/D(L) COV 2206 

IF (L.EQ.1) GO TO 6¢ COV 230 
Je Lb =41 COV 246 

IF (J.GT.M1) C(J,J) = 1.@/D(J) COV 250 

DO 2@ K=L,N1 COV 260 

Z(K) = C(J,K) COV 27¢ 

2¢ CONTINUE COV 280 

I = Nl COV 29¢ 

DO 4@ KA=J,N1 COV 300 

SUM = @.¢@ COV 310 

IF (1.EQ.J) SUM = DBLE(C(I,J)) COV 320 

DO 30 K=L,N1 COV 330 

SUM = SUM - DBLE(Z(K))*DBLE(C(K,I)) COV 34¢ 

3@ CONTINUE COV 35¢@ 
cC(I,J) = SUM COV 360 
ITeI-1 COV 370 

46 CONTINUE COV 38¢ 

DO 5@ K=L,N1 COV 39¢ 
C(J,K) = C(K,J) COV 40¢ 

5@ CONTINUE cov 41¢ 
L=L-1 COV 42¢ 

IF (L.GT.1) GO TO 1¢ COV 43¢ 

60 IF (N1.EQ.N) GO TO 9¢ COV 44¢ 
N1IP1 = Nl +1 COV 45¢ 

DO 8¢@ I=1,N COV 46¢ 

DO 7@ J=N1P1,N COV 470 

C(I,J) = 0.0 COV 48¢ 

7@ CONTINUE - COV 49¢ 

8@ CONTINUE COV 5¢¢ 

C PERMUTE THE COLUMNS AND ROWS OF MATRIX C TO ACCOUNT FOR PIVOTING. cov 51¢ 
9% DO 12@ I=1,N COV 52¢ 
DO 10@ J=1,N COV 536 

K = IPIVOT(J) COV 54¢ 


Z(K) = C(I,J) CoV 55¢ 
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166 CONTINUE 
*--:po 11@ J=1,N 
C(I,J) = Z(J) 
11@ CONTINUE 
12@ CONTINUE 
DO 15@ I=1,N 
DO 13¢ J=1,N 
K = IPIVOT(J) 
Z(K) = C(J,1) 
136 CONTINUE 
DO 149 J=I,N 
C(J,I) = Z(J) 
14@ CONTINUE 
15@ CONTINUE 
RETURN 
END 


SUBROUTINE ERROR(IFAULT, K, Z) 
SUBROUTINE ERROR PRINTS ERROR DIAGNOSTICS IN THE CASE OF ERROR 
FAILURE. 
ALSO PRINTED ARE SOME INFORMATIVE DIAGNOSTICS RELATED TO THE 


ROUNDING ERROR PROBLEMS IN COMPUTING THE COVARIANCE MATRIX. 
IN THE DATA STATEMENT BELOW, NW IS THE PRINTER DEVICE NUMBER. 
REAL Z 
DATA NW /6/ 
GO TO (16,20, 30, 46,56,60, 76,86,99,100,116), IFAULT 
1@ WRITE (NW,99999) 
RETURN 
2@ WRITE (NW,99998) 
RETURN 
3@ WRITE (NW,99997) 
IF (K.EQ.2) WRITE (NW,99996) 
RETURN 
4@ WRITE (NW,99995) K,Z 
RETURN 
5@ WRITE (NW,99994) 
RETURN 
60 WRITE (NW,99993) 
RETURN 
7@ WRITE (NW,99992) 
RETURN 
86 WRITE (NW,99991) K 
RETURN 
99 WRITE (NW,9999@) K,z 
RETURN 
10@ WRITE (NW,99989) K,Z 
RETURN 
110 WRITE (NW,99988) K,Z 
RETURN 
C FORMAT STATEMENTS. 
99999 FORMAT (5@H@*** PARAMETER ERROR. M, N AND L MUST BE GREATER, 
* 11H THAN ZERO.) 
99998 FORMAT (5@H@*** PARAMETER ERROR. M1 CANNOT EXCEED M OR N, B, 
* 26HUT M1 MUST BE NONNEGATIVE.) 
99997 FORMAT (5@H@*** DIMENSION ERROR. ONE OR MORE OF THE FOLLOWI, 
* 32HNG ERROR CONDITIONS WAS FOUND --/7X,12HM EXCEEDS MM/7xX, 
* 12HN EXCEEDS NN) 
99996 FORMAT (5X,17HM+N EXCEEDS MMPNN) 
99995 FORMAT (43H@*** WEIGHTS MUST BE NONNEGATIVE. FOR I =,13,2X, 
* QHWEIGHT = ,G15.8) 
99994 FORMAT (5@H@*** EITHER MATRIX H EQUALS ZERO OR MATRIX OF CON, 
* 51HSTRAINTS EQUALS ZERO. NO SOLUTION CAN BE COMPUTED.) 
99993 FORMAT (5@H@*** SINCE THE CONSTRAINTS ARE LINEARLY DEPENDENT, 
* 29H NO SOLUTION CAN BE COMPUTED.) 
99992 FORMAT (39H@*** ALL SOLUTIONS FAILED TO CONVERGE.) 
99991 FORMAT (22H@*** FOR B-VECTOR NO.,13,21H SOLUTION FAILED TO C, 
* SHONVERGE. ) 
9999% FORMAT (22H@*** FOR B-VECTOR NO.,13,21H THE NUMBER OF ITERAT, 
* 45SHIONS REQUIRED FOR CONVERGENCE OF SOLUTION WAS,F4.@6/4H ***, 
* 57H THIS NUMBER IS LARGE, INDICATING THE PROBLEM IS ILL-CON, 
* 4Q@HDITIONED AND SOLUTION MAY BE INACCURATE.) 
99989 FORMAT (22H@*** FOR B-VECTOR NO.,13,21H ESTIMATED NUMBER OF , 
* 54HCORRECT DIGITS IN INITIAL SOLUTION OF COEFFICIENTS IS , 
* G15.8/51H *** SINCE THIS IS SMALL, THE FINAL SOLUTION MAY B, 


aagaaaaa 


ITERATIVE REFINEMENT OF ILL-CONDITIONED SYSTEMS OF EQUATIONS AND TO 
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* 13HE INACCURATE.) 
99988 FORMAT (26H@*** DIAGONAL 
* 5S7HCOVARIANCE MATRIX WAS 
* 13HUNDING ERROR./29H *** 

END 
1 MODE 1 


ELEMENT NO.,13,17H OF THE UNSCALED , 
COMPUTED TO BE NEGATIVE OWING TO RO, 
THE COMPUTED VALUE WAS ,G15.8) 


596 
600 
61¢ 
626 
630 


RRRKEKRKKEREREREKRERERERRERKREREREREKREERERRRERERERKRERRERERREREER 


(1) WAMPLER, J.AMER.STAT.ASSN. 1976, P.549, 5TH DEG. POLYNOMIALS, EQUAL WEIGHTS. 


21 6 i) 2 1 1 
(F2.0, 2F8.@) 


1 d. 


1) 1 766 
1 6 2042 
2 63 2111 
3 364 -1684 
4 1365 3888 
5 3906 1858 
6 9331 11379 
7 196¢8 1756¢ 
8 37449 39287 
9 66430 64382 
1@ 111111 113159 
11 177156 175168 
12 271453 273291 
13 462234 400186 
14 579195 581243 
15 813616 811568 
16 1118481 1121004 
17 1508598 1596550 
18 2000719 2002767 
19 2613660 2611612 
20 3368421 336918¢ 
1 
(2) ot DEGREE POLYNOMIAL, UNEQUAL WEIGHTS. 
2 @ 1 1 2 1 ¢. 
ee 0) 
ds 2 2: 
2 Des Ve 
36 De As 
tes te 
5 ey ee 
6. 7. 2. 
1 
(3) J. M. CAMERON DATA, UNEQUAL WEIGHTS, TWO COLUMNS LINEARLY DEPENDENT. 
7 6 1) 2 2 2 1 Q. 
(2F3.0,F3.1,F3.0,F4.2,F3.0,F5.1,F4.0,F2.0) 
11.5 2.25 213. @ 130 2 
1 2.5 2.25 317.6 170 2 
@ 3.0 3 .6@ 318.2 182 1 
@ 2.0 1.00 1 8.8 881 
@ 1.0-3 .60 @ -3.0 -36 1 
@? 1.6 0.00 @ 2.8 281 
@ 60.0 1.06 @ 2.1 211 
1 
(4) EXAMPLE WITH WEIGHTS AND CONSTRAINTS. 
12 6 3 1 2 2 1: d. 
(8F3.0) 
jae: ee es ies OO ame <8 
11166466 3 1 
1146064646 2 1 
1-1 @ 60646 1 3 
1 @-1 40 @ @-1 3 
1 ¢@ 46-1406 1 3 
1 @ 4 @ @-1-1 2 
@1-1¢4¢960 4601 2 
@ 16 @-1 @-1 2 
@1%6 @ @-1 1 «21 
@ 60 1-1 6 @-1 1 
@6 146-1 40 1 @O4i%21 
1 
(5) INVERSE OF HILBERT MATRIX OF ORDER 4. M = 4, N = 4, Ml = @ 
4 4 ¢ at 2 1 1 d. 
(5F7.@) 
16. -12¢ 240. -140. -4, 
-126. 1200. -2700. 1680. 60. 
246. -2700. 6480. -420¢. -18¢. 
-140. 1680. -4260. 2800 140. 
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(6) INVERSE OF HILBERT MATRIX OF ORDER 4. M = 4, N= 4, Ml = 4. 
4 4 4 a 2 1 as ¢. 
(5F7.0) 
16. -120. 246. -14@. -4. 
-120. 1200. -270¢. 168¢. 60. 
240. -2700. 6480. -4200. -180. 
-149. 1686. -426¢. 28¢¢. 14¢. 
q: 
(7) BUSINGER-GOLUB, NUM. MATH. 1965, P.269, INVERSE OF HILBERT MATRIX, ORDER 6. 
6 1 2 2 1 1 @. 
(5F10.0,10X, 2F1@.) 


36. -630. 3360. -7560. 7560. 463. 463. 

-63¢. 14790.  -8820%. 211680. -220650¢. -1386%. -1782¢@. 
3360. -88260. 564486. -1411200. 1512000. 97620. 93555. 
-7560. 211680. -1411200. 3628890. -3969000. -258720. -261800. 
7560. -22650@. 1512000. -3969000. 44106000. 291060. 288288. 
2772. 83160. -58212@. 1552320. -1746360. -116424. -118944. 
a 

(8) EXAMPLE WITH X = @ (HENCE XNORM = @). TOL = -1 ON ENTRY TO L2A OR L2B. 
1 1 1) 1 2 1 ) -l. 

(2F3.@) 

1. @. 
iL 


(9) ALBERT, REGRESSION AND THE MOORE-PENROSE INVERSE, 1972, P. 63. 
3 4 My) 3 2 1 2 
(7F4.) 
i, Os. dy ds. Ay iOs- 


(16) FIFTH DEGREE POLYNOMIAL WITH HEAVY WEIGHTS, MATRIX A SCALED. TFAULT=11 
21 6 1) 1 2 2 1 1) 

(F8.0, 3F9.0, 2F10.0,F13.2,F10.0) 

1900000. ¢. ¢. @. ¢. @. 100000.1853 16777216. 

1666000. 160000. 16000. 1666. 160. 1. -8277497.00 ie 

16006000. 200000. 40000. 8000. 1600. 32. 8513600.00 

19600000. 300000. 96000. 270600. 8100. 243. -8245855.060 

1000000. 400000. 166006. 64600. 25600. 1624. 10500192.0¢ 

1690000. 500000. 250000. 125000. 62500. 3125. -8191733.00 

1990060. 600000. 360000. 216600. 129600. 7776.  8626944.06¢ 


L 
1 
1 
1 
1 
1600000. 700000. 490000. 343600. 240100. 16807. -8094491.06 1 
1690600. 800000. 640000. 512006. 499600. 32768.  7897376.00 1 
1990000. 960000. 816000. 729000. 656160. 599049. -7920049.00 i. 
1990O6000. 1690000. 10000600. 10460000. 1000000. 100000. 600000.5@ 16777216. 
1009000. 1160000. 1216400. 1331000. 1464140. 161651. -7617047.¢¢0 1. 
19090000. 1200000. 14406400. 1728000. 2073600. 248832.  8521440.0¢ a 
1699000. 1300000. 16990000. 21970600. 2856100. 371293. -7113005.06¢ 1 
1699006. 1466000. 1960000. 2744600. 3841600. 537824. 16626992.¢¢ 1 
1600000. 1560000. 22500600. 3375000. 5062500. 759375. -6310483.00 1 
1909000. 16006000. 2560000. 4996000. 6553600. 1048576. 12963744.¢0 1 
1996000. 17006006. 2890000. 4913000. 8352100. 1419857. -5@83241.60¢ 1 
1960000. 1804000. 3240000. 5832606. 16497600. 1889568. 12515136.60 1 
1960000. 19040600. 3616000. 6859900. 13632100. 2476699. -3272399.6¢ 1. 
1909900. 2600600. 4060000. 8000000. 16000000. 3200000. 6300000.1853 16777216. 
1 
(11) LAWSON-HANSON, SOLVING LEAST SQUARES PROBLEMS, 1974, SET 1 EX.16. IFAULT=1@ 
8 6 4 1 2 1 1 ¢. 
(7F6.@) 
155. 105. -445. -495. -45. -95. -245. 
355. 305. -245. -295. 155. 105. -295. 
-445. -495. -45. -95. 355. 3065. 155. 
-245, -295. 155. 165. -445. -495. 105. 
-45, -95. 355. 305. -245. -295. -445. 
155. 105. -445. -495. -45. -95. -495. 
355. 365. -245. -295. 155. 165. -45. 
-445..-495. -45. -95. 355. 365. -95. 
1 
(12) LAWSON-HANSON, SOLVING LEAST SQUARES PROBLEMS, P.252, SET 1, EX.16, TOL=.5. 
8 6 4 1 2 1 2 @.5 
(7F6.0) 
155. 105. -445. -495. -45. -95. -245. 
355. 3065. -245. -295. 155. 195. -295. 
-445. -495. -45. -95. 355. 3065. 155. 
-245. -295. 155. 165. -445. -495. 105. 
-45. -95. 355. 305. -245. -295. -445. 
155. 165. -445. -495. -45. -95. -495. 
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355. 305. -245. -295. 155. 105. -45. 
-445. -495. -45. -95. 355. 305. -95. 
1 
(13) BJORCK-GOLUB, BIT 1967, P.322, HILBERT MATRIX INVERSE, ORDER 8. IFAULT=8,9 
8 6 2 3 2 1 1 ¢. 
(6F12.0) 
20160. -92400. 221760. -288288. 192192. -5148¢. 
945. 945. 8400945. 
-95256¢. 4656960. -116424¢0. 15567552. -10594584. 2882880. 
~46320. -40632¢. 4159680. 
11430720. -58212000. 149688000. -20432412@. 141261120. -3891888¢. 
456120. 3256120. 3256120. 
-58212000. 304926000. -800415900. 1169968800. -77693616¢. 216216000. 
-2236080. -13608¢. -136080. 
149688006. -800415000. 2134446600.-2996753760. 2118916800. -594594600. 
5599446. 7279446. 7279440. 
-204324120. 1109908806@.-299675376@. 4249941696.-3039051024. 856215360. 
-7495488.  -6095488.  -6095488. 
141261120. -—77693616@. 211891686@.-3630051024. 2175421248. -61837776¢. 
5105100. 6305190. 6305100. 
-38918886. 216216000. -594594¢00. 856215360. -618377760. 176679360. 
-1389960. -339960. -339960. 
I 
(14) LAWSON-HANSON, SOLVING LEAST SQUARES PROBLEMS, 1974, SET 1, EX.12. IFAULT=7 
6 8 6 1 2 1 1 ¢. 
(9F6.0) 
~245. -295. 155. 165. -445. -495. -45. -95. 355. 1 
355. 305. -245. -295. 155. 105. -445. -495. 305. 1 
-45. -95. 355. 305. -245. -295. 155. 165. -245. 1; 
-445. -495. -45. -95. 355. 305. -245. -295. -295. 4, 
155. 105. -445. -495. -45. -95. 355. 3065. 155. 9. 
-245. -295. 155. 165. -445. -495. -45. -95. 105. 16. 
1 
(15) EXAMPLE WITH SINGULAR MATRIX OF CONSTRAINTS. Ml = 3, Nl = 2. IFAULT=6 
6 3 3 1 2 1 1 Q. 
(4F2.0) 
l1lil 
2221 
1¢@1 
1241 
1391 
1491 
1 
(16) EXAMPLE WITH MATRIX A EQUAL TO ZERO (HENCE RANK EQUALS ZERO). IFAULT=5 
3 2 i) 1 2 1 1 ¢. 
(3F2.@) 
@¢1 
@¢01 
@¢1 
1 
(17) EXAMPLE WITH ZERO AND NEGATIVE WEIGHTS. IFAULT=4 
2 1 @ 1 2 2 1 d. 
(2F3.0,F4.0) 
Te de Gs 
1. 1. -1. 
1 
(18) EXAMPLE WHERE N EXCEEDS THE CORRESPONDING DIMENSION LIMIT. LFAULT=3 
1 21 ) 1 2 1 2 ¢. 
(22F2.) 
123456789@123456789@11 
1 
(19) EXAMPLE WHERE Ml EXCEEDS M AND N. LFAULT=2 
1 1 2 1 2 1 1 d. 
(2F3.0) 
re 
1 
(20) EXAMPLE WITH M = @. IFAULT=1 
) 1 ) 1 2 1 1 @. 
(2F3.0) 
Let. 2s 
i) 
2 MODE 2 REKKRERREKREKEREKREKREEKREKRREREERKRKERERARK KKK RRR RRR: 


(3) J. M. CAMERON DATA, UNEQUAL WEIGHTS, TWO COLUMNS LINEARLY DEPENDENT. 


7 6 


") 2 2 2 1 Q. 


(2F3.6,F3.1,F3.0,F4.2,F3.0,F5.1,F4.6,F2.) 


11.5 2 


-25 2 13.6 136 2 
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12. 35 22.255 3719.0 170 2 
@ 3.0 3 .@6 318.2 1821 
@ 2.0 1.00 1 8.8 881 
@ 1.6-3 .66 @ -3.0 -36 1 
@ 1.6 @ .06 @ 2.8 281 
@¢0.0 1.06 @ 2.1 211 


a 
(9) ALBERT. REGRESSION AND THE MOORE-PENROSE INVERSE, 1972, P. 63. 
3 4 i) 3 2 1 2 d. 
(7F4.0) 
1. @ 1. 1. 1. 6 @. 
Os Verde De; Oe Ta 203 
Me be Oe Le Oe OL Ds 
1 
(12) LAWSON-HANSON, SOLVING LEAST SQUARES PROBLEMS, P.252, SET 1, EX.16, TOL=.5. 
8 6 4 Ll 2 1 2 ¢.5 
(7F6.0) 
155. 1065. -445. -495. -45. -95. -245. 
355. 305. -245. -295. 155. 165. -295. 
~445. -495. -45. -95. 355. 305. 155. 
-245. -295. 155. 1065. -445. -495. 1@5. 
-45. -95. 355. 305. -245. -295. -445. 
155. 165. -445. -495. -45. -95. -495. 
355. 305. -245. -295. 155. 165. -45. 
-445. -495. -45. -95. 355. 305. -95. 
Ae 
(14) LAWSON-HANSON, SOLVING LEAST SQUARES PROBLEMS, 1974, SET 1, EX.12. IFAULT=7 
6 8 6 1 2 1 1 ¢. 


-245. -295. 155. 165. -445. -495. -45. -95. 355. i. 
355. 305. -245. -295. 155. 165. -445. -495. 305. Le 
~45. -95. 355. 3065. -245. -295. 155. 105. -245. 13 
-445. -495. -45. -95. 355. 365. ~245. -295. -295. Lis 
155. 105. -445. -495. -45. -95. 355. 3065. 155. 9. 
-245. -295. 155. 105. -445. -495. -45. -95. 165. 16. 
1 
(18) EXAMPLE WHERE N EXCEEDS THE CORRESPONDING DIMENSION LIMIT. IFAULT=3 
1 21 @ 1 2 1 2 ¢. 
(22F2.0) 
123456789¢123456789@¢11 
‘ . MODE 1 KRREKEKREREKRREERRKRRERRRRRRERERRKERERERRRRERRRERRRRRRRRRRRRERKKIER 
(21) FIRST DEGREE POLYNOMIAL, POSITIVE AND ZERO WEIGHTS. COMPARE EXAMPLE (2). 
8 2 ") 1 1 2 d. 
(3F3.0 
je eae 
a mee 
cae pee Le 
ae ame 
i= ame Sh 
66-74 2 
792.0; 
8. 6. @. 
t 
(22) EXAMPLE WITH WEIGHTS AND CONSTRAINTS. COMPARE EXAMPLE (4). 
14 6 3 1 2 2 @. 
(8F3.0) 
Pd A a a. -G 
6 146-1 601421 
1 60 @ @-1 9-1 @ 
@ 146-160 4 1 @ 
1 
(23) EXAMPLE WITH ZERO WEIGHTS, WHERE RANK A = RANK H = 2. H = (SQRT(W))*A. 
4 2 tH) 1 2 2 d. 
(4F3.0) 
Te Oe ly. al 
Oo 122.1 
d. @. 3. ¢@ 
@. 6. 4.04 
a 


(24) EXAMPLE WITH ZERO WEIGHTS, WHERE RANK A = 2, RANK H= 1. H = (SQRT(W))*A. 
4 Z ¢ 1 2 2 0. 


0 
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ALGORITHM 545 
An Optimized Mass Storage FFT [C6] 


DONALD FRASER 
CSIRO, Australia 


Key Words and Phrases: multidimensional FFT, fast Fourier transform, FFT, mass storage FFT, 
mass store sorting, optimal sorting 

CR Categories: 4.9, 5.19, 5.31 

Language: Fortran 


DESCRIPTION 


The program is an implementation of the optimal sorting algorithm of the author 
[8] which allows a base-2 version of the Cooley-Tukey FFT algorithm [2-4] 
efficient access to a mass store array. Optimal sorting for the mass storage FFT 
has been determined independently by DeLotto and Dotti [5, 6], but in the 
author’s version the emphasis is on “in-place” array modification. This results in 
slightly higher mass store I/O than the minimum, but requires no additional mass 
store working space. The method is a logical extension of the work of Singleton 
[9] and Brenner [1]. 

The program computes in place the discrete Fourier transform of a one- 
dimensional or a multidimensional array. In the one-dimensional case the trans- 
form is defined by 

N1-1 


A(J) = SCAL 2 a(j) exp(+ i 27jJ/N1) for J=0,1,...,N1—-—1 (1) 


j=0 
where SCAL is an arbitrary scaling factor, exp is the exponential function, and 
i= V1, the sign of the exponent being either plus or minus, depending on the 
desired transform. 
The definition (1) is easily generalized to cover more than one dimension; for 
example, the two-dimensional case is given by 


N2-1 N1-1 ° 
A(K, J)=SCAL ¥ Y. a(j, k) exp(+ i 20(jJ/N1 + kK/N2)) 
k=0 j=0 


for K=0,1,...,N2—1 and J=0,1,...,NI1-—1. (2) 


The elements a(j) or a(j, k) in (1) or (2) are the initial complex data in a mass 
store array. These are replaced by the elements A(J) or A(K, J) as the final 
complex data. Index reversal in the two-dimensional case is used to indicate 
dimension transposition by the program (dimension order reversal in general). 
This may be suppressed in certain cases. 

The program consists of a set of subroutines written in ANSI Fortran, only two 
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of which are called by a user program. If the data are always complex, the user 
program calls subroutine CMFFT. If the input data or the result are real, the 
user program may call the faster subroutine RMFFT. Either subroutine replaces 
a one-dimensional or a multidimensional array in mass store by its discrete 
Fourier transform, as defined by eq. (1) or (2). 

(If the elements of the mass store array are considered to be singly indexed by 
i= 0, 1, 2,..., then the indices of the definitions map into i = j in the one- 
dimensional case or 1 = j + k-N1 in the two-dimensional case, resultant trans- 
position giving i = K + J-N2. In general, i = j1 + j2-N1 + j3-N2-N1 +.... 
Remember also that indices are increased by 1 for Jfortran.) 

The mass store file is assumed to exist and to have been previously defined to 
the Fortran system and opened for random access by the user. The file is accessed 
through two system-dependent subroutines MFREAD and MFWRIT (see Ap- 
pendix F). All other subroutines are system independent. 

The user has freedom to specify total array size, mass store block or record 
size, core store working space size, and the dimensioning of the array, except that 
all sizes are to base 2 and are given by their binary exponents. 

Complex data are transformed by an in-place, base-2 algorithm using postcom- 
putation bit reversal to sort the array [2]. The computation is handled by a 
modified, in-core FFT routine which does a sequence of partial transforms of the 
mass store array (the method is discussed further in the following section). The 
sorting algorithm [8] calculates the most efficient way to access the mass store 
array for these computations. Finally, the sorting algorithm is used to carry out 
an overall bit-reversed permutation of the array, again with as few accesses as 
possible (I/O efficiency is discussed in the conclusion section). 

Computation and sorting occur in place, through a combination of “virtual” 
permutations, where mass store blocks are accessed according to an indexing 
algorithm but are left physically unpermuted, and symmetric permutations, 
which interchange blocks according to a generalized index bit reversal. In [8] it is 
shown that any unsymmetric permutation can be formed from two suitable 
symmetric permutations, each of which can be done in place. 

Multidimensional transforms are achieved automatically by making use of the 
indexing structure of the FFT algorithm itself. No change to the order of access 
of elements is necessary, so that the full advantage of the sorting algorithm and 
program simplicity is maintained. 

For transforms in which the initial or final data are real, the usual time-saving 
algorithm [4] is available to unscramble a half-length complex transform of 
packed real data (or vice versa). This requires an extra accessing and computing 
pass through the mass store array but still results in a saving of nearly half the 
computation and I/O time. In this method it is easy to allow a choice in the 
degree of redundancy in the final, complex result. The array may be expanded to 
full redundancy (twice the physical length of the original packed real array), or 
to partial redundancy, or maintain the same physical length by elimination of all 
redundancy. 

Finally, we must define a number of terms used in the discussion. “Core store” 
is used to describe a region where the elements of an array are equally accessible 
at random. “Mass store” implies a region where elements are grouped into 
“blocks” or “records” which must be accessed as units, but which units are 
accessible efficiently at random. A “pass” is an array operation which leaves the 
array elements in place ready for another array operation. Thus an “I/O pass” 
reads and writes back once all the blocks of an array (this is a logical definition— 
sometimes in practice not all blocks need be physically accessed, or some may be 
accessed more than once). 


Algorithm Details 


General. The structure of the mass storage FFT' program is shown in Figure 
1. When using real data, routine RMFFT calls CMFIFT with a half-length complex 
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ee . __. —— USER 
|MFPAR H— — v ee FFT 
2 REAL 
HELPER ae 
- po I FFT 
= a CMFFT ee ® 


| DMPERM;~ —_ 
Sone — — | MF RCMP 
dae 


ps TN UNSCRAMBLE 
eS 


IN-CORE FFT ™ 


ae - |MERLOD | 
MF | NDX [MER LOD | 
oe _— 


LOAD 
VIRTUAL PERM 


—, 


MFREAD,MFWRIT | 
MASS STORE 1/0 


Fig. 1. Internal subroutine calling network. (Solid and dashed lines distinguished roughly between 
“main path” and “reference” calls.) 


array before unscrambling by MFRCMP. If necessary, routines CMFFT and 
below may be overlaid with routines MFRCMP and MFRLOD. CMFFT controls 
the sequence of mass store accessing for in-core computation and sorting of the 
complex FFT. Routines MFCOMP and MFRCMP carry out the FFT computa- 
tion and unscrambling of data in core store. MFREV, controlled by routine 
MFSORT, carries out a bit-reversed permutation on elements in core store or on 
whole blocks in mass store. MFLOAD and MFRLOD load and unload core store 
for the in-core routines, calling on MFREAD and MFWRIT (Appendix F). 
MFINDX defines a virtual permutation of the mass store array during the 
complex FFT operation. MFSUM sums elements in the dimensioning list 

MEXA( ), sorting them if necessary. Routine MFPAR is discussed in Appendix 
B and routine DMPERM in Appendix D. 

The main problem in writing a mass store FFT program is to devise an efficient 
means of accessing widely spaced data elements for use in the FFT computation 
kernel and for sorting from bit-reversed order [2]. Singleton [9] describes an 
algorithm for accessing a mass store array two blocks at a time to carry out each 
computing pass of an FFT. He organizes mass store accesses in such a way that 
each I/O and computing pass results in a one-place cyclic shift of array element 
index bits. This allows the FFT kernel program to access the same elements in 
core store on each pass, which not only simplifies the program but also brings 
“widely separated” elements in the original array “within reach” of the in-core 
computation. Bit-reversed sorting is done in a similar manner. For an array of 
2«*M elements, the basic method requires (2M — 1) I/O passes. 

With efficient, random access mass store it is possible to use an indexing 
algorithm to read widely scattered blocks, equivalent to a virtual permutation of 
the array. After an in-core operation the blocks are written back in place, the 
blocks remaining physically unpermuted by the operation. In [8] an algorithm is 
described which uses this method to compute the FFT. The indexing subroutine 
MFINDX computes the required sequence of block indices using an algorithm 
which is a generalization of the Block Indexing Algorithm of [8, p. 303]. This is 
equivalent to a cyclic shift (a number of places) of a set of the block index bits. 

Complex Data. Unlike Singleton’s algorithm, an attempt is made to load as 
many blocks together as possible in core store. In this way it is possible to include 
a number of FFT computing passes while the blocks are in core store, reducing 
the number of I/O passes by a factor ICEX — IBEX (see the conclusion section). 
Routine CMFFT uses a slightly modified version of the algorithm of [8, p. 307] 
for this purpose, doing M — C instead of M — B initial computing passes with 
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virtual permutations, followed by final C pass computations with direct access, 
instead of final B pass computations. I/O efficiency is unchanged, but the 
algorithm is neater (sizes being 2**B elements per block, 2**C in core store, 2**M 
total, all complex). 

Routine MFCOMP computes the FFT in core store. But, unlike other FFT 
routines, the number of computing passes NPAS, and the effective initial pass 
number IPAS, are not fixed but are passed by the calling routine CMFFT. 
Weighting factors are computed using SIN, COS functions on mass store block 
boundaries but recursively within block boundaries, while array element accessing 
is ordered to minimize these computations. Multidimensional transforms are 
achieved by restarting the weighting factor sequence over passes corresponding 
to the exponent of each dimension, requiring no change to the order of access of 
elements. 

Finally, routine MFSORT is called to sort the array from bit-reversed order. 
The algorithm is a slightly modified version of the sorting algorithm of [8, pp. 
305-307], to allow the reversal of a more general set of index bits. Its structure is 
very similar to CMFFT, having a first stage using the virtual cyclic shift permu- 
tation for block access, with pairs of in-core bit-reversed permutations (MFREV) 
instead of FFT computations. (The pairs allow unsymmetric cyclic bit shift 
permutations to be done in place, in core). Only one in-core permutation is 
required on the first I/O pass. These are followed by a final bit-reversed permu- 
tation of whole blocks, if necessary. 

In the special case when IDIR = 0, MFSORT is called a number of times to 
individually reverse bits corresponding to each dimension exponent. This allows 
the complex FFT to be done without dimension reversal (but note that dimension 
reversal is required by RMFFT). The dimension shifting subroutine DMPERM, 
of Appendix D, also uses this feature. In both these cases, I/O is not fully 
optimized and specially written programs could reduce the number of I/O passes 
by combining some of the separate, in-core permutations. 

Bit-reversed index pairs are generated by a very efficient recursion algorithm 
(routine MFREV). The algorithm maintains a hierarchy of “reversed” integers of 
increasing number of bits, up to 2 less than the number being reversed. Incre- 
menting a reversed integer then requires the alternate simple addition of a 
constant or replacement by the next lower incremented reversed integer in the 
hierarchy, recursively. For example, with a 3-bit reversal, the reversed set is 
(0, 4, 2, 6, 1, 5, 3, 7) where the next value is obtained either by adding 4 to the last 
or by replacing it by one of the values (0, 2, 1, 3) of a 2-bit reversed set. 

This method of reversed series generation is in itself fast, as recursion depths 
are small on the average. But, in addition, only quarter-length series are generated 
(—2 bits) and the full-length series is derived by scaling by 2 and adding offsets. 
This is equivalent to reversing an integer a(integer — 2 bits)b to b(reversed 
integer — 2 bits)a where a and b are the outer bits. There are four possible 
combinations for ab, but only those reversals greater numerically than before 
reversal are required (to prevent nullifying double swaps), leaving in general the 
three offsets 1---0,0---0, and 1---1. In particular, only the first offset is required 
if the internal (reversed integer — 2 bits) is smaller than or the same as before 
reversal. Thus, only valid swap index pairs are generated, saving the unnecessary 
reversed integer generation of some other methods. 


Real Data. For transforms in which the initial or final data is real, a half-length 
complex transform of packed real data must be unscrambled (or vice versa) by 
routine MFRCMP. The method relies on complex-conjugate symmetry in the 
transform of real data [4]. Calculation of indices of multidimensional symmetry 
is more difficult than in the one-dimensional case. To do this a recursion algorithm 
is used, which is most easily described by the following Fortran program (for two 
dimensions, N1-by-N2 elements): 


L2 = N2/2+1 
DO 1J2 = 1, L2 
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K2 = N2+ 2-—J2 
IF(J2.EQ.1)K2 = 1 
L1=N1 
IF(J2.EQ.K2)L1 = N1/2+ 1 
DO1J1=1,L1 
K1=N1+2-Jl1 
IF(J1.EQ.1)K1 = 1 
C Now have A(K1, K2) and A(J1, J2) as a pair with conjugate symmetry 
1 CONTINUE 


Note is taken of the special cases which exist when the J index is 1 (Fortran) and 
when the J and K indices are equal. The general case follows by repetition of the 
code between the two DO statements, replacing J2 by Jj, etc. In routine 
MFRCMP arrays JAYA(4), etc., are used for this purpose. To increase the 
number of dimensions allowed in RMFFT (Appendix A), increase the array sizes. 
To help visualize the result, the index relationships (Fortran index —1) for an 8- 
by-4 array are as follows (r for real IF(index(K1, K2).EQ.index(J1, J2)), where 
index(J1, J2) = J1 + (J2 —1)*N1, for example, c for complex conjugate): 
r00. O01 02 O38 r04 c03 c02 cOl 
10 11 #12 18 «14 «15~«216~«#17 


r20 21 22 23 r24 #c23 c22 c21 
cl0 cl7 cl6 cl5 cl4 cl38 cl2 cll 


The array above represents the transformation and transposition of a 4-by-8 
real array (imaginary part zero). However, we may also consider it to represent 
the scrambled transform of an array of initially packed real data, occupying 
alternately real and imaginary elements, that is, initially 8-by-8 real values. In 
this case the result is only half-length, element pairs such as 15 and cl5 above 
containing information which can be unscrambled to give a new element 15 and 
an element 33 in place of c15. In addition, new elements cl15 and c33 are derived. 
Thus the array is expanded to an 8-by-8 full transform of the real data: 

r00 O1 02 038 r04 c03 cO02 cOl 
10 11 12 #18 «#14 «15 «#16 «#17 
20 21 22 23 24 25 26 27 
30 381 32 33 34 35 36 37 
r40 41 42 43 r44 c43 c42 c4i1 
c30 c37 ¢c386 ¢385 «6¢34 «6¢33 0 «6c82) Oc 1 
c20 c27 c26 ¢25 c24 c23 c22 c2l1 
cl0 cl7 cl6 ec15 cl4 cl3 cl2 cll 


Note that the same indexing algorithm applies in both examples (with different 
N2) but during unscrambling and expansion only the half-length symmetry is 
used (N2 = 4); corresponding expanded rows in the new array are obtained by a 
direct offset (4 in this case). Thus, by half-length symmetry, initial rows I and 3 
are accessed together for unscrambling; these are replaced by unscrambled rows 
1 and 3 of the full array while new rows 5 and 7 are also computed and added to 
the array. It is this ability to add data beyond the existing data which makes 
dimension reversal essential for in-place computation in the real mass store FFT 
routine RMFFT. 

The complete array is “fully redundant,” nearly half the elements being 
complex conjugates of the other half. If the last three rows of the example are left 
out, the result is “partially redundant,” since row 0 and row 4 still have some 
internal redundancy. To eliminate all redundancy, rows 0 and 4 can be merged 
(c43, c42, c41 replacing c03, c02, cO1), and pairs of real elements combined as 
single complex elements (r40 as the imaginary part with r00 real, r44 with r04). 

The exact algorithm by which an array with IPAK = 0 or —1 (see Appendix A) 
can be restored to full redundancy is given by the half-length symmetry program 
above, putting 


A(J1, J2 + N2) = CONJG(A(K1, K2)) 
A(K1, K2 + N2) = CONJG(A(J1, J2)), IF (J2.NE.1) 
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with special provision IF(J2.EQ.1) when IPAK = —1: 


A(K1, K2 + N2) = A(K1, K2) 
A(J1, J2 + N2) = CONJG(A(K1,K2)) 
A(K1, K2) = CONJG(A(J1, J2)) 


and IF(index(K1, K2).EQ.index(J1, J2)) when IPAK = —1, values are real: 


A(J1, J2 + N2) = CMPLX(AIMAG(A(J1, J2)), 0.) 
A(J1, J2) = CMPLX(REAL(A(J1, J2)), 0.) 


the general case follows with Jj and Nj instead of J2 and N2 and as before with 
repetition of the code between DO statements. 


Conclusion 


The number of I/O passes through the mass store array depends on the array 
size (2**M), the core store working space size (2**ICEX), and the I/O block or 
record size (2**IBEX). In general, the larger the working space and the smaller 
the block size the better, but block size should not be made too small because of 
other overheads. The FFT computation requires 


I ((M — IBEX + 1)/(ICEX — [BEX)) 


passes involving I/O (where .¥(x) is the smallest integer greater than or equal to 
x). Postcomputation sorting requires a similar number of passes (without sorting 
overlap), although DeLotto and Dotti [5] mention 


IF ((M — ICEX + 1)/(ICEX — IBEX)) 


passes. The reason this is not achieved is that in-place sorting requires 
M — IBEX + 1 virtual permutations to leave a physically unpermuted array. A 
change in the algorithm to a smaller number M — ICEX + 1 virtual permutations 
requires an extra block-sorting pass of mass store, nullifying the advantage. 

Figure 2 gives the maximum range of block size exponent IBEX necessary to 
keep the number of I/O passes N of the mass store array low, given ICEX and M. 
Solid lines bound the optimum N = 4. Dashed lines are the boundaries for the 
next best N = 6 passes, and it should not be difficult to operate with N = 4 or 6 
in most cases. When calling the half-length transform by subroutine RMFFT, 
increase diagram M and N by 1 to obtain the working M and N. 

The hatched line cutting across the figure gives a bound below which all mass 
store passes access all blocks. In the area above the line, 


JF (IBEX — 1)/(ICEX — IBEX)) 


sorting passes are required with an additional pass of rnass store involving a block 
reshuffle, in which only some of the blocks are accessed. That is, the optimum 
can approach N = 3 passes. Given an I/O system which allows alteration of the 
index key of a block, the block shuffle can be replaced by an index shuffle, giving 
N — 1 passes in the upper area. Note also that the diagram is only approximate, 
as integral rounding effects may increase or decrease the number of passes by 
one at some points. 

Run time depends on two main factors, the computation time of the in-core 
FFT and the I/O time. A total elapsed time can be written approximately 


T = TC#M+2#*M + TM+#N#2*+*#M 


where TC and TM are unit computation and unit mass store average access and 
transfer times corresponding to each complex element. As an example, consider 
two very different computer systems, a PDP 11/40 system and a CYBER 76 
installation. Then we may expect TC = 0.5 ms (PDP 11) or 2 us (CYBER), and 
TM = 1 ms (PDP 11, IBEX = 7) or 0.5 ms (CYBER, IBEX = 9) for routine 
CMFFT. Calling subroutine RMFFT with packed real data roughly halves the 
time, so that a 256-by-256 real array can be transformed in about 5 min (PDP 11) 
or 1s (CYBER) CPU time and 8 min (PDP 11) or 1 min (CYBER) elapsed time. 
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Fig. 2. Mass store I/O passes N related to binary exponents IBEX, ICEX, and M for routine 
CMFFT. Increase diagram values of M and N by 1 to obtain working M and N for routine RMFFT. 


But in machines such as the CYBER, where computing speed is very great 
compared to I/O latency, the routines are used to great advantage for transform- 
ing arrays in LCM (extended memory) in place of mass store, using high-speed, 
block-copy operations between this and main memory (see Appendixes E and F). 
Whether an array is multidimensional or not makes little difference to efficiency. 

Both TC and TM are block size dependent, there being fixed overheads per 
block. Both therefore can be written 


TC = TCO + TCA/2«*(IBEX — 1), TM = TMO + TMA/2+*(IBEX — 1) 


where TCA is the FFT computation overhead per block and TMA is the average 
mass store access time per block. TCO and TMO are the limits for large block 
size. TCA and TMA set a useful lower limit for block size. In the examples above 
TM is mainly the result of TMA, or system block access time. Increasing block 
size reduces TM but with a probable increase in N (depending on M and ICEX). 
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TC is mainly due to TCO, TCA becoming important: typically when IBEX < 5. 
To determine the most efficient parameter combination, begin by choosing ICEX 
as large as possible; use Figure 2 as a guide in choosing IBEX but follow this up 
by timing comparisons over a range of IBEX. | 

The program was written to test the sorting algorithm [8] in practice. At the 
same time a useful and efficient Fourier program has been obtained, operating 
with a very general set of parameters. Some parameter combinations can lead to 
short cuts, not detected or implemented here (see the section, Algorithm Details). 
Efficiency in a particular case can no doubt be improved by some recoding at the 
expense of a loss in generality or increase in code complexity. 

Hopefully this program will stimulate designers not only of fast transforms but 
also of general purpose systems. Sorting by index bit manipulation should be 
considered an important concept for new machine architecture. Index bit reversal 
is simple to achieve in hardware and, in its generalized form [8], is a symmetric 
permutation (allowing in-place operation) which forms the basis of a number of 
useful permutations, not exclusively associated with the FFT. 


Appendix A. Program Usage 
The complex FFT routine is called by 
CALL CMFFT (MEXA, NDIM, ISGN, IDIR, SCAL, BUFA, IBEX, ICEX) 


while the faster, real-to-complex (or vice versa) FFT routine is called by 
CALL RMFFT (MEXA, NDIM, ISGN, IDIR, SCAL, BUFA, IBEX, ICEX, IPAK) 


where the subroutine arguments have the following meanings: 


MEXA Integer array of size NDIM (defined below). MEXA consists of a list of 
dimension size binary exponents, defining the dimensioning of the mass 
store array. For example, a one-dimensional array has a size of 
2*+MEXA(l1) elements. A two-dimensional array has 2**MEXA(2) sets 
of 2*+MEXA(1) adjacent elements each (N1 and N2 of definition 
equations (1) or (2) are 2**MEXA(1) and 2+*MEXA(2) in initial order). 

Notes: (1) The FFT routines actively modify the MEXA list, if 
necessary, leaving it in the order corresponding to the final array 
dimensioning. In general, its order is reversed by the FFT, except in the 
special case with routine CMFFT discussed under parameter IDIR 
below. The MEXA list should therefore be linked to a unique mass 
store array so that it always indicates the current dimensioning of that 
array. 

(2) The MEXA list of exponents always refers to the dimensioning 
of a full array, as required by routine CMFFT or by routine RMFFT 
with IPAK = +1 (defined below). The complex result of routine 
RMFFT operating on real data is truncated when IPAK = 0 or —1, so 
that the MEXA list elements in these cases may refer to a virtual array 
length. 

(3) The first element of the list always gives the size 2**« MEXA(1) of 
the set or sets of adjacent elements in the first dimension of the mass 
store array. If data are of type complex, this is the number of complex 
elements in each set while if data are of type real (e.g., before calling 
routine RMFFT in direction real to complex), this is the number of real 
elements. 

(4) Mass store array dimensioning is independent of I/O block 
transfer size and core working space size. 

NDIM Number of dimensions in mass store array (size of MEXA list). Range 
1 <= NDIM < 4 (RMFFT), to increase (see the section, Algorithm 
Details), or 1 = NDIM = M (CMFFT). 

(M) Not a call parameter, but defined here for convenience. M = sum to 
NDIM of MEXA list, giving total mass store array size = 2**M elements 
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ISGN 


IDIR 


SCAL 


BUFA 


IBEX 


ICEX 


IPAK 


(number of complex elements for routine CMFFT, real or complex 
elements for routine RMFFT; but see under IPAK packing parameter 
below). 

The sign of ISGN is the sign of the complex exponent of the transform 
definition (e.g., eq. (1) or (2)). A positive or negative sign results in the 
inverse transform of the other; but see also below. 

Transform direction (RMFFT), reversal (CMFFT) parameter. Routine 
RMFFT converts packed real data to complex data (or vice versa) 
during transformation, so that IDIR is needed to determine the direc- 
tion, independently of ISGN; thus 


IDIR = —1, real to complex (RMFFT), dimension reversal; 
IDIR = +1, complex-to-real (RMFFT), dimension reversal. 


(Note that it is usually most convenient to use the same variable for 
both ISGN and IDIR so that a single negation results in transform 
inversion.) 

Routine CMFFT does not need a direction parameter, other than 
ISGN, and IDIR is used in this case to set dimension reversal (trans- 
position in two dimensions) or not, as required, thus 


IDIR not zero, dimension reversal (more efficient I/O); 
IDIR = 0, do not use (RMFFT), suppress reversal (CMFFT). 


Arbitrary type real scale factor of eq. (1) or (2). If SCAL = 1.0 
computation is fastest as no scaling occurs. 

Array in core to be used as workspace by FFT routines. Note that 
internal FFT subroutines assume the following: (1) BUFA is either type 
real or complex, to suit local needs. (2) BUFA is given the trivial 
dimension BUFA(1) internally, since its actual size is known only as 
the exponent ICEX (defined below). (3) Type complex data are assumed 
to be stored in the sequence real/imaginary/real/imaginary/... in core 
store and mass store. Some of these points may upset some Fortran 
compilers, 

Mass store I/O block transfer size binary exponent. 

Block or record size = 2**IBEX real elements. 


Limits are 2 = IBEX s ICEX — 2 (RMFFT), 
or 1 <= IBEX = ICEX — 1 (CMFFT). 


Core store working space size binary exponent. 
Dimension of BUFA = 2**«ICEX real elements. 


Limits are IBEX + 2 = ICEX = M (RMFFT), 
or IBEX + 1s ICEX = M + 1 (CMFFT). 


Packing parameter (routine RMFFT only). Determines the degree of 
redundancy (discussed further in the section, Algorithm Details) desired 
in the complex result after a real-to-complex transform; thus: 

IPAK = +1 gives a fully redundant complex result. The final mass 
store array is exactly twice the physical length of the 
initial real array, having the same number, 2*+M, of 
complex elements as initial real elements. This is the same 
result that is obtained when calling CMFFT with the 
initial data occupying the real part of a complex array, 
zero imaginary. 

IPAK =0 _ gives a partly redundant complex result, slightly longer 
than the initial real array. In this case there are 2*+*(M — 
1) + 2**(M — MEXA(NDIM)) complex elements in the 
final array, the MEXA list in the order after the transform 
(increased to an integral number of mass store blocks, if 
necessary). This is probably the most useful packing. 
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IPAK = —-1 gives a result containing no redundancy and having ex- 
actly the same physical length as the initial 2**M real 
elements, or 2**(M — 1) complex elements. This is 
achieved by squeezing together those parts of the array 
cussed in the section, Algorithm Details. No information 
is lost and, for one or two dimensions, only a little sorting 
is needed to access unsqueezed information. For example, 
in one dimension, the real value at the Nyquist frequency 
becomes the imaginary part of the zero frequency element, 
which also must be real. 

Notes: (1) For IPAK = +1 or 0 the mass store array file must be 
extendable. IPAK = —1 has the advantage that the mass store array 
file remains a fixed length, but has the disadvantage that some user 
effort is needed to access complex data correctly. 

(2) In the complex-to-real direction, IPAK = +1 or 0 are squalene 
since only part of a fully redundant complex array is accessed by 
RMFFT in this direction. But IPAK = —1 must be used in both 
directions to correctly handle the squeezed complex array. 


Appendix B. Helper Routine 


To help the user set up the arguments of Appendix A and to determine the mass 
store file and block sizes, a helper routine MFPAR is included. Use of the routine 
is not essential, but is recommended. The routine is called by 


TERR = MFPAR (IRMF, ICOMP) 


with IRMF = —1 if mass store data are currently packed real or +1 if data are 
currently complex when using routine RMFFT. When using routine CMFFT, 
IRMF = 0. If ICOMP = 0 the argument exponents MEXA( ), IBEX, and ICEX 
are defined by the user while if ICOMP is not zero the exponents are to be 
computed by MFPAR. 

Three COMMON blocks are used to transmit other data; thus 


COMMON/MFARG/MEXA (4), NDIM, ISGN, IDIR, SCAL, IBEX, ICEX, IPAK 
COMMON/MFVAL/DIMA (4), TDM1, RDM1, FBLK, TBLK, RBLK, RCOR, SIZE 
COMMON/MFINT/ NDMA(4), NTD 1, NRD1, NFBK, NTBK, NRBK, NRCR, NSZE 


MFARG holds a four-element MEXA( ) list (for up to four dimensions) 
followed by the other mass store FFT call arguments (except BUFA). NDIM, 
IBEX, ICEX, and IPAK must be preset (unless ICOMP not zero), while ISGN, 
IDIR, and SCAL are ignored here. 

COMMON blocks MFVAL and MFINT return data computed by routine 
MFPAR. These include the four-element arrays DIMA( ) and NDMAC( ) corre- 
sponding element by element to MEXA( ) but containing the actual dimension 
sizes 2**MEXA( ). Similarly, RBLK, NRBK, RCOR, and NRCR hold the sizes 
2**IBEX and 2*+*ICEX. Note that MFINT variables are one-to-one integer 
conversions of MFVAL variables, which are of type real. A local variable 
FIXMAX determines whether a conversion is allowed (set to 32767. by a data 
statement in MFPAR, but which may be altered to suit). Any values not 
converted are set to —1 in MFINT and the function returns MFPAR = —1 to 
indicate this. IBEX and ICEX are forced to be within the limits defined in 
Appendix A, and MFPAR = +1 if IBEX is forced too small. Otherwise the 
function returns MFPAR = 0 normally. 

If the helper subroutine argument ICOMP is not zero, the computation is 
reversed and MEXA( ) exponents are computed frorn given DIMA( ) real sizes, 
IBEX and ICEX computed from RBLK and RCOR real sizes. Sizes are adjusted 
to be integral powers of 2, adjusted up or down to the closest power on a log 
scale. NDIM and IPAK must still be given in MFARG. 
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The most useful values computed by MFPAR are NTD1, NRDI1, NFBK, 
NTBK, and NRBK (in MFINT). NRBK is 2**IBEX and is the number of reals 
in the “record” used for mass store access by the FFT. NTBK is the current total 
number of records of size NRBK or the current file length. NFBK, on the other 
hand, is the maximum number of records of size NRBK to be expected, including 
any mass store array expansion by routine RMFFT (see IPAK = 0 or 1 in 
Appendix A). NFBK is thus useful for defining the maximum file length to the 
operating system. 

NRD1 is the number of reals in an equivalent record of the current first 
dimension length (‘‘first” defined by current MEXA(1)). NTD1 is the current 
number of such equivalent records and these two values are useful for logically 
accessing a multidimensional mass store array by the user (though not so useful 
if NDIM = 1). Note that to do this the I/O routines MFREAD and MFWRIT 
must be able to handle correctly records different in length from NRBK; otherwise 
NTBK and NRBK should be used. This will be system dependent (see 
Appendix F). 

NSZE, SIZE is the effective total size of the mass store array (2**M) and is 
useful, for example, in computing the scale factor SCAL. . 

Note that MFPAR should be called just prior to user file access, and with the 
correct value for IRMF, to ensure the computed variables reflect the current 
state of the mass store array. 


Appendix C. Example 


Suppose we wish to transform a two-dimensional real array having 512 rows 
(2**9) of 256 adjacent real elements each (2**8), or a total of 128K real elements 
(2**17), where K = 1024. Suppose we decide to allow a core store working space 
of 8K real elements (2**13) and to access the mass store array in blocks of 128 
real elements (2+*7) each, these being quite independent of array dimensioning. 
Then, using the helper routine MFPAR (Appendix B) to compute file parameters, 
the mass store file is defined and opened for random access, loaded with data, 
and subroutine RMFFT is called with 


COMMON/MFARG/MEXA(4), NDIM, ISGN, IDIR, SCAL, IBEX, ICEX, IPAK 
COMMON/MFVAL/DIMA(4), TDM1, RDM1, FBLK, TBLK, RBLK, RCOR, SIZE 
COMMON/MFINT/NDMA(4), NTD1, NRD1, NFBK, NTBK, NRBK, NRCR, NSZE 
COMMON BLOCKS USED BY HELPER ROUTN MFPAR (NOT ESSENTIAL) 


aQ 


REAL BUFA(8192) 
COMPLEX CBUFA(4096) 
EQUIVALENCE (BUFA(1), CBUFA(1)) 
C WORKING ARRAY IN CORE (EQUIVALENCED FOR USER ACCESS) 


MEXA(1) = 8 
MEXA(2) = 9 
NDIM = 2 

ISGN = -1 

IDIR = —1 

SCAL = 1.0 

IBEX = 7 

ICEX = 13 

IPAK = 1 

MASS STORE FFT ARGUMENTS INITIALIZED 


QQ 


IRMF = - 1 

ICOMP = 0 

IERR = MFPAR (IRMF, ICOMP) 
C HELPER ROUTINE, DATA REAL, RMFFT, EXPONENTS DEFINED, 
C IFUERR.EQ.0) OK 
C COMPUTES FILE PARAMETERS IN COMMON AREAS (NOT ESSENTIAL) 


(open mass store file here) 


C HERE CAN OPEN MASS STORE FILE, NFBK MAX ‘RECDS’ OF NRBK REALS 
C 
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DO 2JB=1,NTD1 (or NTBK) 
DO 1I=1, NRD1 (or NRBK) 
BUFA(I) = (Enter a real variable here) 
CALL MFWRIT (BUFA, NRD1, JB) (or (BUFA, NRBK, JB)) 
LOAD MASS STORE FILE WITH PACKED REAL DATA 
(IF MFREAD/MFWRIT REQUIRE FIXED RECD LENGTH, USE NTBK, NRBK) 


QAQQnNe 


CALL RMFFT (MEXA, NDIM, ISGN, IDIR, SCAL, BUFA, IBEX, ICEX, IPAK) 
resulting in the transform of eq. (2), with SCAL = 1.0, N1 = 256, N2 = 512, and 
a negative complex exponent. Because the initial data are packed real and because 
the parameter IPAK = 1 is chosen, the mass store array will be extended to 128K 
complex elements, or twice its initial physical size. This array is a fully redundant 
transform of the original, having 256 rows (2**8) of 512 adjacent complex elements 
(2«**9), the dimensions being reversed or transposed. To indicate transposition to 
the MEXA list will be reversed (MEXA(1) = 9, MEXA(2) = 8 after the trans- 
form). 

To save unnecessary array extension, the last parameter IPAK can be made 0 
or —1. If IPAK = 0 the result is a partially redundant transform, being the first 
129 rows (2**MEXA(2)/2 + 1) of the transform, of 512 adjacent complex elements 
each. The first and last rows each have an internal conjugate symmetry, but other 
redundancy is deleted. 

If IPAK = —1 the first and last rows above are “squeezed” together, the second 
half of the last row becoming the second half of the first row. In addition, the first 
and middle real elements of the last row become the imaginary parts of the first 
and middle elements of the first row, resulting in an array of 128 rows of 512 
complex elements, exactly the same physical length as the initial array, so that 
no file extension is necessary (see the section, Algorithm Details). 

The complex result is accessed, then an inverse transform is called by 

IRMF = 1 

IERR = MFPAR (IRMF, ICOMP) 


HELPER ROUTINE AGAIN, DATA COMPLEX, ROUTINE RMFFT, 
IF(IERR.EQ.0) OK 


NCNT = NRD1/2 (or NRBK/2) 

NCNT IS THE NUMBER OF COMPLEX ELEMENTS IN RECORD 
DO 4JB=1, NTDI1 (or NTBK) 
CALL MFREAD (BUFA, NRD1, JB) (or (BUFA, NRBK, JB)) 
DO 31 = 1, NCNT 


OQ aaa 


vv) 


(access each complex element CBUF(I) here) 


CALL MFWRIT (BUFA, NRD1, JB) (or (BUFA, NRBK, JB)) 


COMPLEX RESULT READ BY USER (WRITING NEW VALUES IF DESIRED) 
(IF MFREAD/MFWRIT REQUIRE FIXED RECD LENGTH, USE NTBK, NRBK) 


AaQ 


ISGN = —ISGN 

IDIR = —IDIR 

SCAL = 1.0/SIZE 

CALL RMFFT (MEXA, NDIM, ISGN, IDIR, SCAL, BUFA, IBEX, ICEX, IPAK) 


The scale factor SCAL, using SIZE = 2.**M computed by MFPAR, is chosen 
here to normalize the result to the same scale as the original data. The result is 
a real array having 512 rows of 256 adjacent real elements each, the MEXA list 
being restored to its initial order. 


Appendix D. Bonus Routine 


The sorting algorithm used in the mass storage FFT may also be used for 
changing the order of dimensioning of a multidimensional mass store array. This 
is similar to, but more general than, Eklundh’s method [7]. As an example, and 
in addition to the FFT routines, a dimension-shifting routine DMPERM is 
included for completeness, called by 


CALL DMPERM (MEXA, NDIM, NSHFT, IREX, BUFA, IBEX, ICEX) 
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where the arguments MEXA, NDIM, BUFA, IBEX, ICEX have the same 
meaning as in the FFT calls. 
The other parameters are 


NSHFT Dimension shift count. 
NSHFT = 0 No shift or change occurs. 
NSHFT = 1,2 etc. First-to-next dimension, circular NSHFT place 
shift, modulo (NDIM). 
NSHFT = -1 Dimension order reversed. 
IREX “Element size” binary exponent (size = 2**TREX reals); 
thus [REX = 0 for real array, IREX = 1 for complex array. 


Most of the comments concerning the FFT routine parameters apply also to 
this routine. The mass store array is either real or complex (or “elements” of 
multiple reals), with an MEXA list defining the current dimensioning (binary 
exponents). The MEXA list is actively modified by the routine if necessary. (Note 
that to sort arrays of elements smaller in size than type real, such as the type 
byte elements of some systems, it is necessary to alter type statements for BUFA 
and TEMP variables in all subroutines called.) 

The routine is quite trivial in design, consisting of only 20 statements. It 
operates by calling the generalized mass store bit-reversed sorting routine 
MFSORT, used internally by the FFT routines, and therefore has a similar I/O 
efficiency to the FFT routines (see the conclusion section). 


Appendix E. Test Programs 


A universal test program is provided which sets up, for a given M, exhaustive 
permutations and combinations of the different parameters IBEX, ICEX, and 
NDIM from one to three dimensions. Mass store is simulated, through dummy 
routines MFREAD and MFWRIT, by a core store array so that the program is 
independent of system I/O. 

The program stores a pseudorandom number sequence in the simulated mass 
store, transforms this by the mass store FFT routines, and compares the result 
with a discrete Fourier transform computed naively by routine NAIVE. An 
inverse mass store FFT is called and the result compared with the initial data. 
Maximum differences are noted and various levels of data and difference print- 
out are available through parameter IPRINT. The test is considered successful 
if maximum differences are explainable in terms of machine roundoff errors. 

Because the tests are exhaustive and because of the naive DFT computation 
the program is quite slow when the overall array size exponent M is other than 
very small. For example, ina CYBER 76 computer with M = 5 the program takes 
0.3 s while with M = 10 the program takes about 800 s. Less exhaustive testing 
can be done by replacing program DO-loop variables by fixed variables (see 
program comments). 

Example test programs are also included for accessing mass store in two specific 
computer systems. These are a CYBER 76 (true mass store and LCM “static” 
mass store) and a PDP 11. Mass store I/O routines for other systems should be 
easily devised based on these examples and the comments of Appendix F. 


Appendix F. System-Dependent I/O Routines 


The system-dependent random access transfers between mass store and core 
store are handled by two subroutines called internally by the FFT routines; thus 


CALL MFREAD (BUFA, NB, JB) read block into core store 
CALL MFWRIT (BUFA, NB, JB) write block from core store 


where BUFA is the core store address for the start of the transfer, NB is the 
number of real elements to be transferred, and JB is the desired block or record 
number. The range of JB is as follows: 


for CMFFT or RMFFT if IPAK = +1, 
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1<JB < 2**(M — IBEX + 1), 
for RMFFT if IPAK = 0, 


1<JB Ss 2««(M — IBEX) + 2*«(M — MEXA(NDIM) — IBEX + 1), 
for MEXA(NDIM) + IBEX <M + 1, 


or 
1s JB s 2*+(M — IBEX) + 1, for MEXA(NDIM) + IBEX =M + 1, 


(the MEXA list in the order after the transform) 
for RMFFT if IPAK = —1, 


1<JB s 2**(M — IBEX). 


In addition, the I/O subroutines must know what file to access and any starting 
block offset, which may be given through COMMON variables, for example. The 
routines expect the mass store file to be defined and opened. The user program 
may, of course, call MFREAD and MFWRIT itself to load mass store with data 
or read the transform result. . 

For example, in PDP 11 Fortran a random access occurs with 


SUBROUTINE MFREAD (BUFA, NB, JB) 
C READ BLOCK, INDEX JB, FROM MASS STORE TO BUFA, NB REAL VALUES 

REAL BUFA(NB) 

COMMON/FFTCOM/LUN 

READ (LUN’JB)(BUFA(I), I =1,NB) or READ (LUN’JB) BUFA 

RETURN 

END 
and similarly for subroutine MFWRIT. 

As discussed in Appendixes B and C it may be useful to call MFREAD/ 

MFWRIT with a record length NB different from 2**IBEX. This can give a user 
more logical access to a multidimensional array, in records of first dimension 
length, for example. Some systems allow a redefinition of the file structure, in 
which case the problem is solved. Others allow a “word-addressable’” file structure 
in which an I/O transfer may start at any word in the file. In this case, MFREAD/ 
MFWRIT can include the following: 


INDEX = (JB — 1)*NB + 1 


(transfer between file real element indices (INDEX) and (INDEX + NB — 1). 
The dummy I/O routines of the universal test program of Appendix E and the 
CYBER Extended Core/LCM and PDP 11 Macro routines include this feature. 

Subroutines MFREAD and MFWRIT allow the user considerable scope for 
modifying the operation of the FFT routines. In the universal test driver program 
(Appendix E) the subroutines simply copy data from one core store array to 
another. In some systems external core store can be accessed efficiently in blocks, 
which allows this to be used as a fast, static mass store. Using different files on 
the first I/O pass for MFREAD and MFWRIT allows data to be copied auto- 
matically from a source file to a working and result file. In this case care must be 
taken to allow only a single read of each block of the source file, any subsequent 
read, even on the “first” I/O pass, being from the working file (important during 
complex-to-real transformation by routine RMFFT). 
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THIS SET OF PROGRAM AND SUBROUTINE UNITS IS TO SUPPORT 
"AN OPTIMIZED MASS STORAGE FFT', BY DONALD FRASER 
REVISION DATE: JULY 1978 (MINOR REV JUNE 79). 


THE SET INCLUDES A UNIVERSAL TEST DRIVER PROGRAM, WHICH SIMULATES 
MASS STORE THROUGH A FORTRAN ARRAY, SAMPLE PROGRAMS AND 1/0 
SUBROUTINES FOR CONTROL DATA 60¢0@ AND CYBER COMPUTERS AND FOR 
DEC PDP 11 MINICOMPUTERS. 


I/O SUBROUTINES FOR OTHER SYSTEMS SHOULD BE EASILY CONSTRUCTED 
FROM THE EXAMPLES AND WITH REFERENCE TO THE FORMAL PAPER. 
BUT CARE SHOULD BE TAKEN WITH SOME FUSSY COMPILERS SINCE FFT 
SUBROUTINES ASSIGN EITHER TYPE REAL OR TYPE COMPLEX TO THE SAME 
ARRAY AS IT IS PASSED AS A FORMAL PARAMETER. NOTE THAT COMPLEX 
DATA IS ASSUMED TO BE STORED REAL/IMAG/REAL/IMAG... IN BOTH 
MASS STORE AND CORE STORE. 


THE PROGRAM UNITS APPEAR IN THE FOLLOWING ORDER: 


FIRST, THE FFT SUBROUTINE SET: 


1 RMFFT OPTIMIZED MASS STORAGE FFT (REAL DATA OR REAL RESULT) 
2 CMFFT CALLED BY 1, OR MASS STORAGE FFT (ALL COMPLEX DATA) 
3. MFCOMP IN-CORE FFT 

4 MFSORT MASS STORE SORTING 

5 MFREV IN-CORE SORTING OR WHOLE BLOCK SORTING 

6 MFLOAD LOADING/UNLOADING CORE STORE 

7 MFINDX BLOCK INDEXING ALGORITHM (VIRTUAL PERMUTATION) 

8 MFSUM MEXA() EXPONENT SUMMATIONS 

9 MFRCMP REAL-COMPLEX UNSCRAMBLING/ SCRAMBLING 

16 MFRLOD LOADING/UNLOADING CORE STORE FOR MFRCMP 
11 MFPAR HELPER ROUTINE (NOT ESSENTIAL, BUT RECOMMENDED) 
12 DMPERM MASS STORE DIMENSION SHIFTING (BONUS SUBROUTINE) 


THEN, TEST PROGRAMS AND SAMPLE I/0 SUBROUTINES 


13 UNIVERSAL TEST PROGRAM (SIMULATED MASS STORE, NEEDS 14 TO 17 ALSO) 


14 RANMF RANDOM NUMBER GENERATOR 

15 NAIVE DISCRETE FOURIER TRANSFORM COMPUTED NAIVELY 
16 MFREAD DUMMY I/O ROUTINE USING SIMULATED MASS STORE 
17 MFWRIT AS ABOVE 


18 CYBER MASS STORE SAMPLE PROGRAM 
19 MFREAD/MFWRIT CYBER MASS STORE I/O ROUTINE 


2@ CYBER EXTENDED CORE/LCM SAMPLE PROGRAM 
21 MFREAD/MFWRIT CYBER EXTENDED CORE/LCM I/O ROUTINES 


22 - PDP 11 MASS STORE SAMPLE PROGRAM ; 
23  MFREAD PDP 11 STANDARD FORTRAN MASS STORE I/O ROUTINES 
24 MFWRIT AS ABOVE 


25 PDP 11 FAST MACRO I/O SAMPLE PROGRAM (NEEDS MACRO OPEN SUBRTN) 
26 MFREAD/MFWRIT PDP 11 FAST MACRO I/O ROUTINE FOR RSX11M/RT11. 


END 


SUBROUTINE RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 


REAL-TO-COMPLEX FFT (OR VICE-VERSA) OF MULTI-DIMENSD MASS STORE ARRAY 


(FRASER, ACM TOMS - 1978/79, AND J.ACM, V.23,N 2, APRIL 76, PP. 298-309) 
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aa 


Cc 
C 
10 


C 
C 
C 
C 
C 
C 


MASS STORE ARRAY IS EITHER REAL OR COMPLEX DATA (SEE NOTE BELOW) 


NOTE WELL THAT TYPE COMPLEX DATA MUST EXIST AS ALTERNATING 
REAL/IMAG/REAL/IMAG... ELEMENTS, BOTH IN MASS STORE AND IN FORTRAN 
WORKING ARRAY BUFA; IN THIS FFT, DIFFERENT SUBROUTINES WILL SET 
DIFFERENT TYPE (REAL OR COMPLEX) FOR ARRAY BUFA. 


MEXA(J) LIST OF DIMENSION SIZE EXPONS (BASE 2), ADJACENT VARIABLES FIRST 
NDIM IS NUMBER OF EXPONENTS IN LIST AND THUS THE NUMBER OF DIMENSIONS 
SUM TO NDIM OF MEXA(J) = M, WHERE 2**M IS EFFECT SIZE OF MASS STORE ARRAY 
THUS, 2**M PACKED REAL VALUES, 
OR, 2**M COMPLEX VALUES, IF COMPLEX RESULT WITH IPAK=1 (SEE BELOW) 
RMFFT ALWAYS REVERSES DIMENSION ORDER AND MEXA LIST (TRANSPOSED, IF 2 D) 


ISGN GIVES SIGN OF COMPLEX EXPONENT OF TRANSFORM (+ OR -), AND 
IDIR DETERMINES DIRECTION OF TRANSFORM, THUS: 
IDIR=-1, REAL-TO-COMPLEX 
IDIR=+1, COMPLEX-TO-REAL 
SCAL IS REAL MULTIPLIER OF RESULT (EG. SET SCAL=1. FWD, 1./2**M INV) 


BUFA IS CORE STORE WORKING ARRAY BASE ADDRESS (SEE NOTE ABOVE) 
IBEX, ICEX ARE BLOCK AND CORE SIZE EXPONENTS, THUS 

2**IBEX IS NUMBER OF REAL ELEMENTS IN MASS STORE BLOCK 
2**ICEX IS NUMBER OF REAL ELEMENTS IN CORE STORE BUFA 


IPAK IS ARRAY PACKING DETERMINATOR, THUS: 

IPAK=+1 EXPANDS COMPLEX ARRAY TO FULL REDUNDANCY (SAME AS SUBRTN CMFFT) 
IPAK=@ COMPUTES COMPLEX ARRAY OF JUST OVER HALF SIZE (COMMON METHOD) 
IPAK=-1 HOLDS COMPLEX ARRAY AT EXACTLY HALF SIZE (2**(M-1) CMPLX ELMTS) 


MASS STORE ARRAY MUST .BE OPEN FOR ACCESS BY USER SUBRTNS MFREAD/MFWRIT: 
EG. SUBRTIN MFREAD(BUFA,NB,JB) AND MFWRIT(BUFA,NB,JB) TRANSFER ONE 
BLOCK, INDEX JB, BETWEEN MASS STORE AND CORE STORE BUFA, NB REALS 
(1.LE.JB.LE.2**(M-IBEX) IF REAL, OR 2**(M-IBEX+1) IF CMPLX AND IPAK=1) 


COMPLEX BUFA(1) . 
INTEGER B,MEXA(1) 


MH=MFSUM(MEXA,NDIM, 99)-1 
B=ILBEX~-1 
LF(IDIR.GT.@)GO TO 1¢@ 


BELOW, REAL-TO-COMPLEX TRANSFORM 
MEXA(1)=MEXA(1)-1 
CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
CALL MFRCMP (MEXA,NDIM,ISGN,IDIR,IPAK, BUFA,B,MH) 
MEXA (NDIM)=MEXA (NDIM)+1 
RETURN 


BELOW, COMPLEX-TO-REAL TRANSFORM 
MEXA (NDIM)=MEXA (NDIM) -1 
CALL MFRCMP (MEXA,NDIM,ISGN,IDIR,IPAK, BUFA,B,MH) 
CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
MEXA (1) =MEXA(1)+1 
RETURN 


END 


SUBROUTINE CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 


COMPLEX FFT OF MULTI-DIMENSD MASS STORE ARRAY, CALLED BY USER OR RMFFT 
FOR COMMENTS, SEE SUBRTN RMFFT; ARGUMNTS HAVE SAM# MEANING EXCEPT FOR 
IDIR=+1 OR -1, ARRAY ALWAYS COMPLEX, DIMENSION ORDER REVERSED 
WHILE IDIR=@, DIMENSION ORDER (AND MEXA LIST) ARE NOT REVERSED 


COMPLEX BUFA(1) 
INTEGER B,C,MEXA(1) 
DATA LSET/1/,LREAD/1/,LWRIT/2/ 


M=MFSUM (MEXA,NDIM, 99.) 
MREAL=M+1 

B=ILBEX-1 

C=ICEX~1 

NC=2*%*C 

IPAS=@ 
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MPAS=M-C 
NPAS=C-B 
C MOST EFFICIENT USE OF CORE STORE - TRIES TO DO C-B PASSES PER LOAD 
IDUM=MFINDX (LSET,B,M,M,NPAS) 
C DUMMY CALL TO MFINDX TO SPECLFY VIRTUAL (B.'S'.M)**(C-B) PERMUTATION 
Cc 
C FIRST, PIECE-MEAL ATTACK ON FFT COMPUTATION FOLLOWS 
10 IF(MPAS.LE.@) GO TO 4@ 
LF (MPAS ..LT.NPAS) NPAS=MPAS 
2¢ CALL MFLOAD(LREAD, BUFA, IBEX, ICEX, [FLG) 
C LOAD CORE WORKING SPACE WITH 2**(C-B) BLOCKS ACCORDING TO MFINDX 
IF(IFLG.LT.@) GO TO 3¢ 
CALL MFCOMP (MEXA,NDIM,ISGN, BUFA,B,C,M, NPAS,IPAS) 
C DO MODIFIED IN-CORE FFT, REQUIRING NPAS PASSES STARTING WITH IPAS 
CALL MFLOAD(LWRIT, BUFA, IBEX, LCEX, IFLG) 
C UNLOAD CORE AREA, WRITING BLOCKS BACK IN-PLACE TO MASS STORE 
GO TO 206 
30 IPAS=IPAS+NPAS 
MPAS=MPAS-NPAS 
GO TO 1¢ 
C END OF FIRST PART 
Cc 
C SPECIFY BLOCKS TO BE READ IN NEXT PART IN TRUE ORDER (NO PERM) 
4@ IDUM=MFINDX(LSET,B,M,M,@) 
C FINAL, CONCLUDING ATTACK.ON FFT COMPUTATION FOLLOWS 
50 CALL MFLOAD(LREAD, BUFA, IBEX, ICEX, IFLG) 
IF(IFLG.LT.@)GO TO 8@ 
CALL MFCOMP (MEXA,NDIM,ISGN, BUFA,C,C,M, C,IPAS) 
C DO FINAL, C-PASS IN-CORE FFT OF EACH CORE-LOAD 
IF(SCAL.EQ.1.)GO TO 7@ 
DO 6@ J=1,NC 
60 BUFA(J)=BUFA(J) *SCAL 
70 CALL MFLOAD(LWRIT, BUFA, IBEX, ICEX, IFLG) 
GO TO 5¢ 
Cc 
C BELOW, SORT ARRAY (FULL BIT-REVERSAL AND DIMEN REVERSAL IF IDIR.NE,@) 
80 IF(IDIR.EQ.@)GO TO 9¢ 
CALL MFSORT (BUFA, IBEX, ICEX, 1,MREAL,MREAL) 
M=MFSUM(MEXA, NDIM, -1) 
C DO FULL BIT-REVERSAL OF M BITS (AND REVERSE MEXA LIST) 
RETURN 
C 
C BELOW, REVERSE BITS OF EACH DIMEN SEPARATELY (NO DIMEN REVERSAL) 
96 TH=1 
DO 1¢@ J=1,NDIM 


IG=IH 
IH=IH+MEXA (J) 
10@ CALL MFSORT(BUFA, IBEX, ICEX, 1G, IH,MREAL) 
RETURN 
C 
END 
SUBROUTINE MFCOMP (MEXA,NDIM,ISGN, BUFA,B,C,M, NPAS,IPAS) 
c 


C MODIFIED, IN-CORE FFT OF 2**C ELEMENTS, NPAS PASSES STARTING WITH IPAS 
C MEXA, NDIM, ISGN ,BUFA AND M HAVE SAME MEANING AS IN RMFFT COMMENTS 
C B,C EQUIVALENT TO IBEX,ICEX EXCEPT HERE REFER TO NUM COMPLEX ELMTS 
C (2**C CMPLX ELMTS IN CORE STORE BUFA, IN BLOCKS OF 2**B CMPLX ELMTS) 
C 
C FFT W PHASE FACTOR COMPUTED RECURSIVELY EXCEPT ON BLOCK BOUNDS 
C MULTIDIMEN FFT ACHIEVED BY REPEATING W SEQUENCES 
C 

INTEGER B,C,SPAN, STEP ,MEXA(1) 

COMPLEX TEMP ,W,D,BUFA(1) 

DATA LINDX/@/,LREST/4/ 


DATA PI/3.141592653589793/ 
PIMOD=P1L*2.0** (1-M) 
IF (ISGN.LT.@) PIMOD=—PIMOD 
NC=2**C 
C 
C BELOW, NPAS COMPUTATION PASSES WHILE DATA IN-CORE 
DO 5@ JPAS=1,NPAS 
KPAS=IPAS+JPAS-1 
C KPAS IS GLOBAL COMPUTING PASS NUMBER (JPAS-1 IS LOCAL) 
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KDIFF=M—MFSUM(MEXA,NDIM,KPAS ) 
KPEFF=KPAS+KDIFF 
C KPEFF IS EFFECTIVE GLOBAL PASS FOR MULTIDIMEN. FFT W GENERATION 
D=CEXP (CMPLX(@. ,PIMOD*2 .@**KPEFF) ) 
C D IS USED FOR RECURSIVE MODIFICATION OF W PHASE FACTOR 
C 
ITEM=C-JPAS 
SPAN=2**1 TEM 
STEP=2*SPAN 
SPAN SEPARATES VALUES IN FFT KERNEL, STEP TO NEXT PAIR, SAME W 


Qa 


IF(B.LT.ITEM) ITEM=B 
NB=2**I TEM 
IF (ITEM.GT.KDIFF) ITEM=KDIFF 
NRPT=2** ITEM 
NRPT COUNTS REPETITION OF W FOR MULTIDIMEN. FFT 


Oa 


IMOD=2** (M-B-KPAS~1) 
IF(IMOD.LE.1)GO TO 2¢ 
IDUM=MFINDX(LREST,@, 6,9, @) 
MEXP=KPEFF 
ITEM=KDIFF-B 
IF(ITEM.GT.@)GO TO 1¢ 
MEXP=B+KPAS 
ITEM=@ 
16 NCLR=2** ITEM 
PIMOD2=P IMOD* 2. @**MEXP 
C IMOD AND NCLR ARE USED TO COMPUTE W WITHOUT EXCEEDING SMALL INTEGER 
C 
C BELOW, START OF ONE PASS THROUGH CORE, NOTING BLOCK BOUNDARIES 
20 DO 5@ I1=1,SPAN,NB 
W=(1.,0.) 
IF(IMOD.LE.1)GO TO 36 
INDWM=MOD (MFINDX(LINDX, 9, 6,0, @)-1, IMOD) /NCLR 
ANDWM=INDWM 
W=CEXP (CMPLX(@. , PIMOD2*ANDWM) ) 
C NEW W COMPUTED DIRECTLY AT BEGINNING OF NEW BLOCK AREA 
C 
C BELOW, COMPUTATIONS WITHIN EACH BLOCK OF 2**B CMPLX ELMTS 
30 DO 5@ 12=1,NB,NRPT 
Cc 


C BELOW, REPETITION OF SAME W DUE TO MULTIDIMEN FFT 
DO 4@ 13=1,NRPT 
I4=114+12+13-2 
C 
C BELOW, STEPPING THOUGH INDICES HAVING SAME W IN ONE DIMEN FFT 
DO 49 J=I4,NC,STEP 
K=J+SPAN 
TEMP= (BUFA(J)-BUFA(K) ) *W 
BUFA (J)=BUFA(J)+BUFA (K) 
40 BUFA(K)=TEMP 
C FFT 2-POINT KERNEL ARITHMETIC (ALGORITHM BIT-REVERSAL FOLLOWS COMPUT) 
C 
W=W*D 
C RECURSIVE MODIFICATION OF W WITHIN BLOCK BOUNDARIES 
50 CONTINUE 
RETURN 
C 
END 


SUBROUTINE MFSORT(BUFA, IBEX, ICEX,1IG,IH,M) 


BIT-REVERSED PERMUTATION (IG.'R'.IH) OF MASS STORE REAL ARRAY 
REVERSES IH-IG BITS IN INDEX (M-1,...,IH-1,...,IG,...,0) 

NOTE THAT THIS IS MORE GENERAL THAN THE FULL M-BIT REVERSAL 
OF REFERENCE (FRASER, J.ACM, V.23, N.2, APR. 76, P. 306), 

BUT ALGORITHM IS LOGICALLY THE SAME, WITH ALTERED BIT LIMITS. 
BUFA, IBEX, ICEX AND M HAVE SAME MEANING AS IN COMMENTS IN RMFFT 
(BLOCKS 2**IBEX, CORE BUFA 2**ICEX, TOTAL 2**M, ALI REAL) 


AQAAQAAAAAA 


REAL BUFA(1) 
DATA LSET/1/,LPERM/2/,LREAD/1/,LWRIT/2/ 
c 
IDUM=MFINDX(LSET, LBEX,M,M,@) 
C DUMMY CALL TO INITIALISE MFINDX (INITIALLY UNPERMUTED ARRAY) 
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LF (LH-1G.LE. 1) RETURN 
IF(IG.GE.IBEX)GO TO 5¢@ 
IF(IH.LE.ICEX)GO TO 60 
C CHECK FOR SPECIAL CASES, REQUIRING SIMPLER TREATMENT 
Cc 
C BELOW, MIXED PERMUTATION OF BOTH ELEMENTS AND BLOCKS 
IPAS=@ 
NPAS=ICEX-IBEX 
C MOST EFFIENT USE OF CORE STORE - TRIES TO DO ICEX-IBEX PASSES PER LOAD 
MPAS=IH-I BEX 
IF (IBEX-IG.LT.MPAS )MPAS=I BEX-IG 
Cc 
C BELOW, FIRST VIRTUAL 'S' PERMUTATIONS 
16 LF (MPAS.LE.@)GO TO 4¢ 
IF(MPAS.LT.NPAS) NPAS=MPAS 
IGCOR=IG+IPAS 
LF((IGCOR.GT.IBEX-1) .AND. (IGCOR.GT.IBEX+NPAS-1))GO TO 3¢ 
IF ((IPAS.EQ.@) .AND. (IGCOR.GT.IBEX+NPAS-1))GO TO 30 
C BYPASS UNNECESSARY CORE LOAD IF TRIVIAL CASES: 
IDUM=MFINDX (LPERM, IBEX, IH,M,NPAS) 
C DUMMY CALL TO MFINDX TO SPECIFY VIRTUAL (IBEX.S.IH)**NPAS PERM 
c 
C BELOW, LOAD CORE ACCORDING TO VIRTUAL PERMUTATION AND PERM ELMTS 
20 CALL MFLOAD(LREAD, BUFA, IBEX, ICEX, IFLG) 
IF(IFLG.LT.6)GO TO 30@ 
IF(IPAS.NE.@) CALL MFREV(BUFA, IGCOR, IBEX, ICEX, -) 
CALL MFREV(BUFA, IGCOR, IBEX+NPAS , ICEX,-1) 
C CARRY OUT IN-CORE, SYMMETRIC R PERMS. (ONE ONLY ON FIRST PASS) 
CALL MFLOAD(LWRIT,BUFA, IBEX, ICEX, IFLG) 
C UNLOAD CORE AREA, WRITING BLOCKS BACK IN~PLACE TO MASS STORE 
GO TO 2¢ 
Cc 
30 IPAS=IPAS+NPAS 
MPAS=MPAS-NPAS 
GO TO 1¢ 
C END OF FIRST PART 
C 
C BELOW, FINAL 'R' PERM. OF BLOCKS IN MASS STORE, IF (IH-2*IBEX+IG).GT.1 
4g CALL MFREV(BUFA,@, ILH~2* LBEX+1G,M-IBEX, IBEX) 
RETURN 
Cc 
C BELOW, PERMUTATION OF BLOCKS ONLY REQUIRED 
56 CALL MFREV(BUFA, IG-IBEX, IH-IBEX,M-IBEX, IBEX) 
RETURN 
Cc 
C BELOW, PERMUTATION OF ELEMENTS IN CORE ONLY REQUIRED 
60 CALL MFLOAD(LREAD, BUFA, LBEX, ICEX, IFLG) 
LF(IFLG.LT.@) RETURN 
CALL MFREV(BUFA,IG, IH, ICEX,~1) 
CALL MFLOAD(LWRIT,BUFA, IBEX, ICEX, IFLG) 
GO TO 6¢@ 


END 


SUBROUTINE MFREV(BUFA, IG, IH,M, IBEX) 


BIT-REVERSED PERMUTATION OF RANDOMLY ADDRESSABLE ELEMENTS 

REVERSES IH-IG BITS IN INDEX (M-1,...,IH-1,...,IG,...,0) 

(GENERAL PERM IG.'R'.IH, FRASER, J.ACM, V.23, N.2, APR 1976, P. 300) 
IF IBEX.LT.@, SORTS 2**M REAL ELMTS IN CORE BUFA, 
IF IBEX.GE.@, SORTS BLOCKS IN MASS STORE 

(2**IBEX REAL ELM[S PER BLOCK AND 2**M BLOCKS IN SECOND CASE) 


THE ALGORITHM MAINTAINS A SET OF 'REVERSED' INTEGERS IN ARRAY IRA() 
OF INCREASING NUMBER OF BITS, UP TO 2 LESS THAN (IH-IG) BITS. 
INCREMENTING A REVERSED INTEGER THEN REQUIRES THE ALTERNATE 

ADDITION OF NRA() TO IRA(), OR REPLACEMENT BY THE NEXT LOWER 
INCREMENTED REVERSED INTEGER IN THE HIERARCHY, RECURSIVELY. 

THIS IN ITSELF IS FAST, AS RECURSION DEPTHS ARE ON AVERAGE SMALL. 

BUT, IN ADDITION, ONLY QUARTER LENGTH SERIES ARE GENERATED (-2 BITS) 
AND THE FULL LENGTH DERIVED BY SCALING BY 2 AND ADDING OFFSETS. 

IN THIS FINAL STAGE, ONLY VALID SWAP PAIRS ARE GENERATED (1 OR 3 EACH) 


WITHIN THE INNER LOOPS, GROUPS OF 2**IG ELMTS ARE MOVED TOGETHER 
WHILE THIS IS REPEATED OVER 2**(M-IH) PARTS OF THE ARRAY, 
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C CORRESPONDING TO THE UNPERMUTED BITS M TO IH AND {G-1 TO @. 
Cc 

REAL BUFA(1) , TEMP 

INTEGER IRA(16) ,NRA(16) , IFOFA(3) , [ROFA(3) 


THG=IH-1G-3 

IF (IHG.LE.-2) RETURN 
C NO PERMUTATION REQUIRED 
C 

NB=2**T BEX 

NB1=NB+1 

NG=2**1IG 

NGDB=NG*2 

NH=2**1H 

NHHF=NH/2 
C NG IS MOVEMENT GROUP SIZE, NH IS PERMUTATION REPLICATION SIZE 

NM=2**M 

NPARS=NM-NH+1 

NREV=NH/4 


DO 10 J=1,IHG 
IRA (J)=@ 
NREV=NREV/2 
10 NRA (J)=NREV 
C REVERSED INTEGER RECURSION SETS INITIALISED 
Cc 
NREV=NH/4 
IFOFA(1)=NG-1 
LROFA(1)=NH/2-1 
IFOFA(2)=-1 
TROFA(2)=-1 
ILFOFA(3)=NH/2+NG-1 
LROFA(3)=NH/2+NG-1 
C THREE PAIRS OF OFFSETS TO CONVERT QUARTER TO FULL LENGTH SERIES 
Cc 
IFOR=@ 
IREV=@ 
Cc 
C BELOW, GENERATE INDEX PAIRS AND SWAP (IREV IS 'TOP' OF IRA() SET) 
26 NOF=3 
IF (IFOR.GE.IREV)NOF=1 
C SELECTS ONCE-ONLY SWAP PAIRS (EITHER 1 OR 3 PAIRS) 
DO 4¢ JOF=1,NOF 
IFOF=LFOFA(JOF) 
TROF=IROFA (JOF) 
DO 4¢ I1=1,NG 
C REPETITION OVER GROUP OR SUPER ELEMENT OF NG ACTUAL ELEMENTS 
IN2F=ILFOR+1 FOF+I1 
IN2R=IREV+IROF+11 
DO 4@ 12=1,NPARS ,NH 
C REPETITION OF SAME PERMUTATION OVER ARRAY PARTS 
IN3F=IN2F+12 
IN3R=IN2R+12 
IF(IBEX.GE.@)GO TO 30 
c 
C BELOW, IN-CORE ELEMENT SORTING 
TEMP=BUFA (IN3R) 
BUFA (IN3R)=BUFA(IN3F) 
BUFA(IN3F)=TEMP 
GO TO 4¢ 
C 
C BELOW, SORTING WHOLE BLOCKS IN MASS STORE 
30 CALL MFREAD (BUFA,NB, IN3F) 
CALL MFREAD(BUFA(NB1) ,NB, IN3R) 
CALL MFWRIT(BUFA,NB, IN3R) 
CALL MFWRIT(BUFA(NB1) ,NB, IN3F) 


C 

40 CONTINUE 

C END OF INNER, REPETITION LOOPS 

C 
IFOR=I FOR+NGDB 

C INCREMENT FORWARD QUARTER-LENGTH INTEGER (ALREADY SCALED BY NG*2) 
LF (IFOR.GE.NHHF) RETURN 

C RETURN FORM SUBROUTINE 

Cc 
IF(IREV.GE.NREV)GO TO 5@ 
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C TEST FOR ALTERNATE METHODS OF REVERSE-INCREMENTING (SIMPLE BELOW) 
C NOTE THAT REVERSE QUARTER-LENGTH INTEGER IS ALREADY SCALED BY NG*2 
C 

IREV=LREV+NREV 

GO TO 20 
Cc i 
C ALTERNATE RECURSIVE ALTERATION TO QUARTER-LENGTH REVERSED SERIES 
5@ DO 6¢@ J=1,IHG 

IF(IRA(J).LT.NRA(J))GO TO 7@ 
60 CONTINUE 
Cc 
C BELOW, SIMPLE INCREMENT OF REVERSE INTEGER, LOWER IN HIERARCHY 
70 TRA (J)=IRA(J)+NRA (J) 


TREV=IRA (J) 
80 LF(J.EQ.1)GO TO 20 
J=J-1 
IRA(J)=IREV 
GO TO 8¢@ 
Cc 
END 
SUBROUTINE MFLOAD (LOAD, BUFA, IBEX, ICEX, IFLG) 
Cc 
C LOADS, UNLOADS GORE STORE ARRAY BUFA, 2**ICEX REALS, 2**IBEX PER BLOCK 
C RETURNS IFLG=+1 NORMALLY, IFLG=-1 WHEN FINISHED ONE PASS OF MASS STORE 
C BLOCKS INDEXED ACCORDING TO VIRTUAL PERMUTATION FUNCTION MFINDX 
C LOAD=1 (LREAD) READS BLOCKS FROM MASS STORE INTO CORE STORE BUFA 
C LOAD=2. (LWRIT) WRITES BLOCKS BACK IN-PLACE TO MASS STORE 
Cc 


REAL BUFA(1) 
DATA LINDX/@/,LHOLD/3/,LREST/4/ 


NB=2** IBEX 
NCB=2** (ICEX-IBEX) 
IF(LOAD.EQ.2)GO TO 3¢ 
IFLG=+1 
IDUM=MFINDX (LHOLD 6,0, @, 0) 
C HOLDS CURRENT MFINDX VALUE FOR ENTRY 2 AND SUBRTN MFCOMP 
DO 1@ J=1,NCB 
K=(J-1) *NB 
JB=MFINDX (LINDX, @,4,9, 0) 
IF(JB.LT.9)GO TO 26 
CALL MFREAD(BUFA(K+1) ,NB, JB) 
C READS BLOCK WITH NEXT VIRTUAL MFINDX INDEX 
1¢ CONTINUE 
RETURN 
26 LFLG=-1 
RETURN 


Cc 
30 IDUM=MFINDX(LREST,@, 0,0, 0) 
C RESETS MFINDX TO START OF IN-PLACE BLOCK 

DO 4@ J=1,NCB 

K=(J-1) *NB 

JB=MFINDX (LINDX, ¢, 0, @, ) 

CALL MFWRIT(BUFA(K+1) ,NB,JB) 
C WRITES BLOCK WITH NEXT VIRTUAL MFINDX INDEX (REPEAT MFREAD SEQUENCE) 
40 CONTINUE 


RETURN 
Cc 
END 
FUNCTION MFINDX(LSPEC,B,H,M,N) 
Cc 
C VIRTUAL 'S' PERMUTATION (FRASER, J.ACM, V.23, N.2, APR. 76, P.303) 
C CYCLIC SHIFTS H-B BITS IN INDEX (M-1,...,H-1,...,B,...,@) 
C COMPUTES NEXT INDEX FOR SEQUENTIAL CORE LOAD, PERM (B.'S'.H)**N 
C BLOCK SIZE EXPON B, MASS STORE EXPON M (@.LE.B.LE.H.LE.M) 
C N IS EFFECTIVE NUMBER OF LEFT SHIFTS PER I/O PASS (-N RIGHT SHIFTS) 
€ 
C NOTE VARIABLE NAMES AS FOLLOWS: 
Cc IPERM IS 'P' OF ALGORITHM 
C NPERM=N (ARGUMENT) IS 'N' OF ALGORITHM 
C ISTEP IS 'Q**P' OF ALGORITHM 
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ANQANANAAN 


io) 


Cc 
1¢ 
C 


c 
Cc 
26 


C 


JAY AND KAY ARE 'J' AND 'K' OF ALGORITHM 
NOTE UPPER BOUND H INSTEAD OF M, REQUIRING 2**(M--H) REPEATS 


LSPEC=@ (LINDX) RETURNS MFINDX FOR INDEX (B,H,M,N DUMMIES HERE) 
LSPEC=1 (LSET) SETS IPERM=@ (UNPERMED), ENTERS B,H,M,N PARAMS 
LSPEC=2 (LPERM) CHANGES THE B,H,M,N PARAMETERS 

LSPEC=3 (LHOLD) HOLDS CURRENT INDEXING STATE (B,H,M,N DUMMIES HERE) 
LSPEC=4 (LREST) RESTORES STATE TO LAST LHOLD (B,H,M,N DUMMIES HERE) 


INTEGER B,H 


IF(LSPEC.EQ.1)GO TO 100 
IF(LSPEC.EQ.2)GO TO 20@ 
IF(LSPEC.EQ.3)GO TO 36¢ 
IF(LSPEC.EQ.4)GO TO 400 


IF(ISTEP.NE.@)GO TO 20 

BELOW, PRECEDES FIRST MFINDX OF A PASS 
IF (NPERM.GT.@) IPERM=MOD (IPERM-NPERM, IHB) 
IF (IPERM.LT.@) IPERM=IHB+IPERM 
ISTEP=2** IT PERM 


26 BELOW, NORMAL GENERATION OF NEXT MFINDX 
MFINDX=JAY+JOFF 
IF (MFINDX.GT.NMB)GO TO 4@ 
KAY=JAY+ISTEP 
JAY=MOD (KAY , NHB) 
LF (KAY .GE.NHB) JAY=JAY+1 
NRPT=NRPT-1 
IF (NRPT.GT.@) RETURN 


C NRPT,JOFF REQUIRED TO REPEAT SEQUENCE ON 2**(M-H) PARTS OF ARRAY 


30 


C 


JOFF=JOFF+NHB 
NRPT=NHB 
JAY=0 

RETURN 


C 4@ BELOW, END OF ONE PASS, PARS RESET, IPERM ALTERED IF INVERSE 


49 
50 


C 


LF (NPERM.LT.@) IPERM=MOD (IPERM-NPERM, IHB) 
MFINDX=-1 

JOFF=1 

ISTEP=@ 

GO TO 3¢ 


C LSPEC=1 (LSET) SETS IPERM=@ (UNPERMED), ENTERS B,H,M,N PARAMS 
1¢0@  IPERM=¢ 
Cc 


C LSPEC=2 (LPERM) CHANGES THE B,H,M,N PARAMETERS (DUMMIES ELSEWHERE) 
20@ #IHB=H-B 


C 


NPERM=N 
NHB=2**IHB 
NMB=2** (M—B) 
MFINDX=IPERM 
GO TO 50 


C LSPEC=3 (LHOLD) HOLDS CURRENT MFINDX INDEXING PARAMETERS 
300 JAYH=JAY 


JOFH=JOFF 
NRPTH=NRPT 


310 MFINDX=IPERM 


C 


RETURN 


C LSPEC=4 (LREST) RESTORES PARAMETERS TO INDEX MFINDX AT LAST LHOLD 
466  JAY=JAYH 


C 


JOFF=JOFH 
NRPT=NRPTH 
GO TO 310 


END 


FUNCTION MFSUM(MEXA,NDIM,MLIM) 


C SCANS MEXA LIST IN REVERSE ORDER, RETURNING (MFSUM.JUST GT.MLIM) 


C 


(IF MLIM LARGE ENOUGH, RETURNS M TOTAL FOR NDIM VALUES) 
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C 
C 


C 


1¢ 


C 


(IF MLIM NEGATIVE, RETURNS M TOTAL, REVERSES ORDER OF MEXA LIST) 


INTEGER MEXA(1) 


MFSUM=0 
IF (NDIM.LE.@) RETURN 


DO 1@ J=1,NDIM 

I=NDIM+1-J 

MFSUM=MFSUM+MEXA (I) 

LF ((MLIM.GE.6) . AND. (MLIM.LT.MFSUM) ) RETURN 
CONTINUE 

LF (MLIM.GE.) RETURN 


C BELOW, REVERSE ORDER OF MEXA LIST 


26 


AANAAARAAAA 


NDIMH=NDIM/2 

DO 26 J=1,NDIMH 
K=NDIM+1-J 
MTEM=MEXA (J) 
MEXA (J) =MEXA (K) 
MEXA (K)=MTEM 
RETURN 


END 


SUBROUTINE MFRCMP (MEXA,NDIM,ISGN,IDIR,IPAK, BUFA,B,M) 


UNSCRAMBLES REAL-TO-COMPLEX FFT OR VICE-VERSA, CALLED BY SUBRTN RMFFT 
MOST ARGUMENTS HAVE SAME MEANING AS IN RMFFT COMMENTS 

BUT 2**B COMPLEX ELMTS IN MASS STORE BLOCK, 

USES (2**B)*4 CMPLX IN BUFA, 'LOWER', 'UPPER' PLUS EXPANSION AREAS 
TOTAL MASS STORE ARRAY SIZE OF 2**M COMPLEX ELMTS. 


COMPLEX ATEM,BTEM, TEMP ,W,D,BUFA(1) 
INTEGER B,JAYA(4) ,KAYA(4) , JWKA(4) ,KWKA(4) ,MEXA(1) 


C JAYA,KAYA, JWKA,KWKA ALLOW UP TO 4 DIMENSIONS - INCREASE IF REQUIRED 


16 


DATA PI/3.141592653589793/ 
DATA LOWER/1/,LUPPR/2/,LCLR/-1/ 


DO 1¢ IDIM=1,NDIM 
JAYA(IDIM)=6 
KAYA(IDIM)=@ 
CONTINUE 


C MULTIDIMEN. CONJUGATE-SYMMETRIC INDICES ZEROED 


C 


LEXPND=1 

NB=2**B 

NBDB=NB*2 

JBOF=2** (M-B) 
MAX=M-B-MEXA (NDIM) 

IF (IDIR*IPAK.LT.@) MAX=M-B 
JBMAX=2**MAX 

IF (MAX.LT.@) JBMAX=1 

IF (IPAK.LT.@) JBMAX=@ 


C JBMAX IS MAXIMUM BLOCK INDEX REQUIRED (DEPENDS ON IPAK) 


C 


IWFG=¢@ 

W=(1.,@.) 

D=CEXP (CMPLX(@. ,P1*2.@** (-MEXA(NDIM) ) )) 
IF (ISGN.LT.@)D=CONJG(D) 


C W IS COMPLEX PHASE FACTOR, D IS RECURSIVE MODIFIER OF W 


C 
20 


3 


JAY=0 

KAY=@ 

IDIM=NDIM 
IF(IDIM.EQ.1)GO TO 4@ 
NUMD=2**MEXA (IDIM) 

JWKA (IDIM) =JAY 

KWKA (IDIM)=KAY 

JAY=JAY *NUMD+JAYA (IDIM) 
KAY=KAY*NUMD+KAYA (IDIM) 
IDIM=IDIM-1 

GO TO 306 


C CONJUGATE-SYMMETRIC BASE INDICES COMPUTED FROM MULTIDIMEN. SET 


C 
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Ag MEX1=MEXA (1) 
C 2**MEX1 IS NUMBER OF VALUES ADJACENT IN FIRST DIMENSION 
IFLG=-1 
IF(MEX1.LE.B)GO TO 14¢ 
C 
C BELOW, FIRST DIMEN. GREATER THAN BLOCK SIZE, MULTIPLE BLOCKS 
NBPD1=2** (MEX1-B) 
NBLCNT=NBPD1 
KINC=NB 
KBINC=NBLCNT-1 
IF (JAY.EQ.KAY)NBLCNT=NBLCNT/2 
JB=JAY*NBPD1+1 
KB=KAY*NBPD1+1 
C JB AND KB ARE BLOCK INDEX PAIRS CONTAINING CONJUGATE ELEMENTS 
J1=0@ 
K1=@ 
c 
50 NCNT=NB+1 
60 CALL MFRLOD (LOWER, IOF, BUFA,NB,JB,JBMAX, JBOF, IDIR,NCNT) 
C LOWER BLOCK LOADED 
IF(JB.GT.JBMAX) IEXPND=-1 
J2=J1+10F 
JB=JB+1 
J3=¢ 
K3=@ 
NEWBLK=NCNT-NB 
IF(IFLG.GE.6)GO TO 8¢ 


Cc 
76 CALL MFRLOD(LUPPR, I1OF,BUFA,NB,KB,JBMAX, JBOF, IDIR, IFLG) 
C UPPER BLOCK LOADED 
LFLG=IFLG+1 
K2=K1+I0F 
KB=KB+KBINC 
C FIRST TIME, UPPER BLOCK STEPS HIGH, FOLLOWING STEPS SMALL NEGATIVE 


KBINC=-1 
Cc 
80 J=J2+53 
K=K2+K3 
C J AND K INDEX CONJUGATE-SYMMETRIC PAIRS IN CORE 
JJ=J+NBDB 
KK=K+NBDB 
IF(IDIR.GT.@)GO TO 180 
C 


C BELOW, UNSCRAMBLING FOR REAL-TO-COMPLEX FFT 
TEMP=(BUFA(J)+CONJG(BUFA(K)))*@.5 
BTEM=BUFA (K) —-CONJG (BUFA (J) ) 

BTEM= (CMPLX (AIMAG (BTEM) , REAL(BTEM) ) )*@. 5*W 
ATEM=TEMP+BTEM 

BTEM=TEMP-BTEM 

BUFA(J)=ATEM 

IF (IEXPND.GT.@) BUFA(JJ)=BIEM 
LF(IWFG.EQ.9)GO TO 15¢@ 

BUFA (K)=CONJG (BTEM) 

LF (IEXPND.GT.@) BUFA (KK) =CONJG (ATEM) 

Cc 

90 J3=J3+1 
K3=KINC-J3 

C IN-CORE INDEX PAIRS STEPPED IN OPPOSING DIRECTIONS 
IF(IDIM.NE.NDIM)GO TO 95 
IWFG=1 

=W*D 

C RECURSIVE MODIFICATION OF W IF UNIDIMEN. TRANSFORM 

95 NCNT=NCNT-1 
IF(NCNT.LE.@)GO TO 10@ 

C ENTER RECURSION ROUTINE IF OPERATION COMPLETE IN CURRENT DIMEN 

LF(J3.EQ.1)GO TO 7@ 
LF(NCNT.GT.NEWBLK)GO TO 8@ 
END OF INNER LOOP (NOTE SPECIAL CASE WHEN J3=1 ABOVE) 


eo ie > 


BELOW, MAY REQUIRE TO READ NEW BLOCKS 
NBLCNT=NBLCNT-1 
IF (NBLCNT.GT.@)GO TO 5@ 
IF (JAY.EQ.KAY)GO TO 6¢@ 
JAY.EQ.KAY NEEDS SYMMETRICAL MIDDLE, OTHERWISE CURRENT DIMEN COMPLT 


aa 


10@ BELOW, RECURSION TO COMPUTE MULTIDIMEN. CONJUGATE-SYMMETRY 
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10@  JAYA(IDIM)=@ 
KAYA (IDIM)=@ 
IDIM=IDIM+1 
IF(IDIM.GT.NDIM)GO TO 12@ 
NUMD=2**MEXA (IDIM) 
LF(NUMD.LE.1)GO TO 12¢@ 
IF(IDIM.NE.NDIM)GO TO 105 
IWFG=1 
W=W*D 
C RECURSIVE MODIFICATION OF W IF MULTIDIMEN. FFT 
105  IF(JAYA(IDIM).EQ.6)GO TO 11¢ 
LF ((JWKA(IDIM) *NUMD+JAYA(IDIM)) .EQ. 
X (KWKA(IDIM) *NUMD+KAYA(IDIM)))GO TO 16@ 
IF(KAYA(IDIM) .EQ.1)GO TO 1064 


C 
1196  JAYA(IDIM)=JAYA(IDIM)+1 
KAYA (IDIM)=NUMD-JAYA (IDIM) 
C RECURSIVE STEPPING OF MULTIDIMEN. CONJUGATE-SYMMETRIC INDEX PAIRS 
GO TO 26 
C 
C BELOW, OPERATION COMPLETE, TIDY UP AND RETURN FROM SUBROUTINE 
12@ DO 130 IAREA=1,2 
CALL MFRLOD(IAREA, LOF, BUFA,NB, LCLR, JBMAX, JBOF, IDIR, IFLG) 
C DUMMY CALL TO MFRLOD TO WRITE ANY UNWRITTEN BLOCKS TO MASS STORE 
130 CONTINUE 


RETURN 
C RETURN FROM SUBROUTINE 
C 
C 


C 149 BELOW, FIRST DIMEN. LESS THAN BLOCK SIZE, INDEX PAIRS ALL IN-CORE 
14@ NUMD1=2**MEX1 
NBPD1=NB/NUMD1 
NCNT=NUMD1 
KINC=NCNT 
KBINC=@ 
LIF (JAY .EQ.KAY)NCNT=NCNT/2+1 
JB=JAY /NBPD1+1 
KB=KAY/NBPD1+1 
C JB AND KB ARE BLOCK INDEX PAIRS CONTAINING CONJUGATE ELEMENTS 
J1=(JAY-(JB-1)*NBPD1) *NUMD1 
K1=(KAY-(KB-1) *NBPD1L) *NUMD1 
GO TO 6¢ 
Cc 
C 15@ BELOW, UNSCRAMBLING WITH WO (IWFG=@¢) MUST BE TREATED DIFFERENTLY 
15@  IF(IEXPND.LT.@)GO TO 16¢ 
C BELOW, ARRAY EXPANSION (EITHER IPAK=+1 OR IPAK=@ AND STILL REDUNDANT) 
BUFA (K)=CONJG (ATEM) 
BUFA(KK)=CONJG(BTEM) 
GO TO 9¢ 
C 16@ BELOW, NO ARRAY EXPANSION (EITHER IPAK=-1 OR IPAK=@ NOT REDUNDANT) 
169 IF(J.EQ.K)GO TO 17¢ 
BUFA (K)=CONJG (BTEM) 
GO TO 9@ 
C 17@ BELOW, SPECIAL CASE IF IPAK=-1 AND ELEMENTS ARE SAME 
17@  BUFA(J)=CMPLX(REAL(ATEM) , REAL(BTEM) ) 
GO TO 9¢ 


C 18@ BELOW, SCRAMBLING FOR COMPLEX-TO-REAL FFT 
180 IF (IWFG.EQ.9)GO TO 266 
BTEM=CONJG (BUFA (K) ) 
199 ATEM=(BUFA(J)+BTEM) 
BTEM= (BUFA (J) -BTEM) *W 
BTEM=CMPLX (AIMAG (BTEM) , REAL (BTEM) ) 
BUFA(J)=ATEM-CONJG (BTEM) 
BUFA(K)=CONJG (ATEM)+BTEM 
GO TO 9¢ 


C 206 BELOW, SCRAMBLING WITH WO (IWFG=@) MUST BE TREATED DIFFERENTLY 
20@  IF(IEXPND.LT.@)GO TO 21¢@ 

BTEM=BUFA (JJ) 

GO TO 19¢ 


C 21@ BELOW, NO REDUNDANCY (EITHER IPAK=-1 OR IPAK=@ OR 1 NOT REDUND) 
210 IF(J.EQ.K)GO TO 226 
BTEM=CONJG (BUFA(K) ) 
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GO TO 199 


C 226 BELOW, SPECIAL CASE IF IPAK=-1 AND ELEMENTS ARE SAME 
2260 BIEM=CMPLX(AIMAG(BUFA(J)),¢@.) 
BUFA(J)=CMPLX (REAL (BUFA(J)) ,@.) 
GO TO 19@ 


END 


SUBROUTINE MFRLOD(IAREA, LOF, BUFA,NB,JB, JBMAX, JBOF, IDIR,NCNT) 


LOADS, UNLOADS CORE STORE ARRAY BUFA, FOR REAL FFT UNSCRAMBLING ROUTINE 
BLOCK SIZE NB CMPLX, BLOCK NUMBER JB (JB=-1 DOES FINAL TIDY 0/P) 
JBMAX IS MAX BLOCK INDX FOR EXPANSN, JBOF OFFSET TO EXPANDING BLOCKS 
IDIR=-1 DIRECTION REAL/CMPLX, +1 CMPLX/REAL 
IAREA=1 (LOWER) OR 2 (UPPER) OF TWO AREAS IN LOGICAL UNSCRAMBLING 
NOTE THAT BLOCK NORMALLY PHYSICALLY LOADED IN THESE AREAS, 
BUT, IF BLOCK ALREADY RESIDENT, MAY BE IN DIFFERENT AREA, SO 
IOF RETURNED AS ACTUAL OFFSET IN BUFA TO LOADED BLOCK. 
USES (2**B)*4 CMPLX IN BUFA, 'LOWER', 'UPPER' PLUS EXPANSION AREAS 
RETURNS IOF AS BUFFER OFFSET TO AREA (MAY NOT BE SAME, IF BLOCK RESIDENT) 


NCNT IS COUNT OF ELEMENTS TO BE ACCESSED IN THIS LOAD, TO ALLOW 
NOTE TO BE TAKEN OF ANY PARTLY FILLED BLOCKS DURING EXPANSION, 
PREVENTING THE READING OF 'NON-EXISTENT' BLOCKS. 

LISTS JBPFA(), NCPFA() OF SIZE NPARF HOLD THIS INFORMATION, DEFAULTS 
TO ALL-READ IF EXCEEDED, BUT INCREASE NPARF ETC, IF PROBLEM. 


DNAANQTAAANANAAAARAAAARANAAAM 


COMPLEX BUFA(1) 
INTEGER JBAREA(2),NCAREA(2) ,JBPFA(5) ,NCPFA(5) 
DATA JBAREA(1)/-1/,JBAREA(2)/-1/,NPARF/5/ 


IF(JBAREA(1) .GE.@)GO TO 2¢ 
C JBAREA() HOLDS INDEX OF BLOCK LOADED IN AREA 1 OR 2 (FIRST TIME -1 BELOW) 


IEXIST=-1 
DO 16 I=1,NPARF 
1¢ JBPFA(I)=-1 
C PRE-CLEARS PARTLY FILLED BLOCK LIST (ONCE BLOCK FILLED, ALSO CLEARED) 


Cc 
26 NBDB=NB*2 
IF(JB.LT.@)GO TO 5@ 
IF(IAREA.EQ.2)GO TO 3¢ 
NCLOW=NCNT 
LF (MOD (NCNT, 2) .NE.@)NCLOW=(NCLOW-1) *2 
30 NCHLD=NCLOW 
IF (IAREA.EQ. 2)NCHLD=NCLOW-1 
LF (NCNT.LT.@)NCHLD=1 
C NCHLD IS THE NUMBER OF ELEMENTS TO BE ACCESSED IN CURRENT READ 
Cc 
DO 4@ I=1,2 
IF(JB.EQ.JBAREA(I))GO TO 14¢ 
4Q CONTINUE 
C TEST DONE TO SEE IF REQUIRED BLOCK ALREADY IN CORE (TRIVIAL IF SO) 
Cc 
C OTHERWISE BELOW, FIRST WRITE OUT RESIDENT BLOCK, THEN READ IN NEW 
50 LOF=(IAREA-1) *NB+1 
C IOF IS BASE OFFSET OF CORE AREA WHERE BLOCK IS TO BE FOUND 
LOFDB=IOF+NBDB 
LF (JBAREA(IAREA) .LT.@)GO TO 9@ 
CALL MFWRIT (BUFA(LOF) ,NBDB, JBAREA (IAREA) ) 
C WRITE OUT BLOCK BEFORE READING NEW BLOCK 
IF(IDIR.GT.@)GO TO 9¢ 
LF (JBAREA (IAREA) .GT.JBMAX)GO TO 9¢ 
IF (NCAREA(IAREA) .GE.NB)GO TO 8@ 
Cc 
C BELOW, IF LAST BLOCK ONLY PART-FILLED, INDEX, ELMTS ACCESSED NOTED 
DO 6@ I=1,NPARF 
IF(JBPFA(I).LT.@)GO TO 70 
60 CONTINUE 
C NO ROOM IN LISTS, DEFAULTS TO ALL READ 
I=NPARF 
LEXIST=1 
70 JBPFA(I)=JBAREA(IAREA) 
RDM1=DIMA (1) 
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IF (IRMF.GE.@)RDM1=RDM1*2. 
TDM1=FSIZ/RDM1 
NCPFA(1)=NCAREA (IAREA) 


Cc 
8¢ CALL MFWRIT (BUFA(IOFDB) , NBDB, JBOF+JBAREA (IAREA) ) 
C SIMILARLY, WRITE OUT BLOCK PAIR IF EXPANDING 
C 
C BELOW, READ BLOCK NOTING BLOCK INDX (READ EXPANDED, IF PART FILLED) 
90 JBAREA (IAREA)=JB 
IF(JB.LT.@)GO TO 13¢ 
CALL MFREAD(BUFA(LOF) ,NBDB, JB) 
C READ REQUIRED BLOCK AND NOTE ACCESS COUNT 
NCAREA (IAREA) =NCHLD 
IF(JB.GT.JBMAX)GO TO 13¢ 
IF(IDIR.GT.9)GO TO 12¢ 
C 
C BELOW, EXPANSION - DOES BLOCK EXIST TO READ 
DO 1¢@ I=1,NPARF 
IF(JB.EQ.JBPFA(I))GO TO 11¢ 
19@ CONTINUE 
IF(IEXIST.LT.@)GO TO 130 
116 JBPFA(I)=-1 
NCAREA (IAREA) =NCPFA (I )+NCHLD 
C IF BLOCK TO BE READ WAS ONLY PART FILLED, THEN IT EXISTS TO READ 
12@ CALL MFREAD(BUFA(IOFDB) ,NBDB, JBOF+JB) 
C READ EXPANDED BLOCK IF REQUIRED 


C 

136 RETURN 

C RETURN FROM SUBROUTINE 
C 


€ BELOW, TRIVIAL CASE - BLOCK ALREADY LOADED 

146 IOF=(I-1) *NB+1 

C IOF IS BASE OFFSET OF CORE AREA WHERE BLOCK IS TO BE FOUND 
IF(I.NE.IAREA)GO TO 15¢ 
NCAREA (I) =NCAREA (1I)+NCHLD 

C INCREASE ACCESS COUNT IF CURRENT IAREA MATCHES ORIGINAL IAREA 

15@ RETURN 

Cc ; 
END 


FUNCTION MFPAR(IRMF, ICOMP) 


HELPER ROUTINE TO CROSS-COMPUTE MASS STORE FFT FILE PARAMETERS 
PARAMETERS ARE HELD AND COMPUTED IN 3 COMMON AREAS (SEE BELOW) 
MFPAR RETURNS @ NORMALLY, -1 IF NOT ALL MFINT CORRECT, +1 IBEX ERROR 


COMMON/MFARG/ HOLDS ARGUMENTS AS USED IN FFT CALLS, AS FOLLOWS: 
VARIABLE NAMES HAVE SAME MEANING AS COMMENTS, SUBROUTINE RMFFT 
MEXA() HOLDS EXPONENTS FOR UP TO 4 DIMENSIONS (R/T ZEROS EXCESS) 
NDIM NUM DIMENS, IBEX,ICEX BLOCK AND CORE EXPONS, IPAK RMFFT PACKING 
ISGN,IDIR,SCAL ARE IGNORED HERE, BUT INCLUDED FOR COMPLETENESS 


COMMON/MFVAL/,/MFINT/ RETURN COMPUTED VALUES, USEFUL FOR FILE ACCESS 
NDMA(4) ,DIMA(4) HOLD DIMENSION SIZES CORRESPONDING TO MEXA() 
(EG. NDMA(1)=DIMA(1)=2.**MEXA(1), ETC. AND =1. BEYOND NDIM) 


NTD1,TDM1 IS CURRENT TOTAL NUM OF 'RECDS' OF SIZE NRD1,RDM1 

NRD1,RDM1 IS NUM OF REALS IN CURRENT FIRST DIMENSION 

(USEFUL FOR ACCESSING DATA BY MFREAD/MFWRIT, NRD1,RDM1 REALS, 
ASSUMING THAT MFREAD/MFWRIT CAN HANDLE 'RECDS' OF DIFFERENT SIZES) 


NFBK,FBLK IS MAXIMUM FILE SIZE OF 'RECDS' OF SIZE NRBK,RBLK 
NTBK,TBLK IS CURRENT TOTAL NUM OF 'RECDS' OF SIZE NRBK,RBLK 
NRBK,RBLK IS NUM OF REALS IN FFT WORKING BLOCK (2**IBEX REALS) 
(GIVES MAX AND CURRENT FILE SIZE AND ACCESS BY FFT ROUTINES, 
NFBK.GT.NTBK ONLY WITH PACKED REAL DATA WHEN EXPANDING, IPAK=@ OR 1) 


NRCR,RCOR IS NUM OF REALS IN FFT WORKING CORE (2**ICEX REALS) 
NSZE=SIZE=2.**M, WHICH IS THE EFFECTIVE TOTAL SIZE OF TRANSFORM, 
WHERE M IS SUM TO NDIM OF MEXA() (SEE RMFFT COMMENTS) 


NOTE THAT ALL /MFARG/ ARE INTGS (EXCEPT SCAL), ALL /MFVAL/ REALS 
(/MFINT/ IS INTEGER CONVERSION OF /MFVAL/, ANY VALUE OF MFINT 

IS SET -1 IF TOO LARGE, BY FIXMAX, AND MFPAR RETURNED -1 AS FLAG, 
FIXMAX SET BY DATA STATEMENT TO 32767. HERE, BUT ALTER TO SUIT) 


ANANQAAANQAARADANQANAAAAAAAAARAANQANDANANAARAANRAAARAAAN 
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C NOTE WELL THAT TYPE COMPLEX DATA MUST EXIST AS ALTERNATING 
C REAL/IMAG/REAL/IMAG... ELEMENTS, BOTH IN MASS STORE AND IN FORTRAN 
C WORKING ARRAY BUFA; IN THIS FFT, DIFFERENT SUBRCUTINES WILL SET 
C ROUTINE ARGUMENTS HAVE THE FOLLOWING EFFECT: 
C IRMF=-1, DATA IS PACKED REAL, +l DATA IS COMPLEX, ROUTINE RMFFT, 
C IRMF=¢, DATA IS COMPLEX, ROUTINE CMFFT 
Cc 
C ICOMP=$, COMPUTES VALUES IN /MFVAL/ FROM VALUES GIVEN IN /MFARG/ 
C ICOMP=1 , REVERSE COMPUTES EXPONENTS IN /MFARG/ FROM /MFVAL/ 
Cc (DIMA(),RBLK,RCOR GIVEN INSTEAD OF MEXA() , IBEX, ICEX) 
Cc 
C NOTE, ROUTINE FORCES ICEX, IBEX TO CORRECT RANGE, MFPAR=+1 IF CANNOT 
Cc 
COMMON/MFARG/MEXA (4) ,NDIM, ISGN, IDIR, SCAL, IBEX, ICEX, IPAK 
COMMON/MFVAL/DIMA(4) , TDM1,RDM1, FBLK, TBLK, RBLK, RCOR, SIZE 
COMMON/MFINT/NDMA (4) ,NTD1,NRD1,NFBK,NTBK,NRBK ,NRCR,NSZE 
REAL VAL(11) 
INTEGER INT(11) 
EQUIVALENCE (VAL(1),DIMA(1)), (INT(1) ,NDMA(1)) 
C 
DATA FLXMAX/32767./,NMAX/4/ 
C 
MFPAR=@ 
IF(ICOMP.EQ.@)GO TO 2¢ 
ALG2=AL0G(2.) 
IBEX=1 FIX (ALOG(RBLK) /ALG2+@. 5) 
ICEX=IF1X (ALOG(RCOR) /ALG2+@. 5) 
Cc 


DO 1@ I=1,NDIM 
1@ MEXA(L)=IFIX(ALOG(DIMA(I)) /ALG2+@.5) 


C 

20 M=¢ 
DO 36 I=1,NMAX 
IF(L.GT.NDIM) MEXA(1)=@ 
M=M+MEXA (I) 

30 DIMA (L)=2.**MEXA(I) 
SIZE=2.**M 

Cc 


IF(IRMF.EQ.%)GO TO 9@ 
IF (ICEX.GT.M) ICEX=M 
IF (LBEX.GT. ICEX-2) IBEX=ICEX-2 
IF(IBEX.LT.2)MFPAR=1 
C FORCES ICEX.NGT.M AND IBEX.NGT.ICEX-2, OR MFPAR=1 (IRMF=+/- 1) 


Cc 
40 RBLK=2.** IBEX 
RCOR=2.**LCEX 
Cc 
FADD=SIZE 
IF(IRMF.EQ.@.OR.IPAK.GT.@)GO TO 5@ 
C FADD IS ADDITIONAL FILE SIZE IN REALS, 'SIZE' IF CMFFT OR IPAK=1 
Cc 
FADD=@. 
IF(IPAK.LT.9¢)GO TO 5@ 
C IPAK=-1 REQUIRES NO FILE EXPANSION 
Cc 
IDIM=NDIM 
IF(IRMF.LT.@) IDIM=1 
FADD=SIZE*2./DIMA(IDIM) 
C FADD COMPUTED FOR PARTICULAR CASE OF IPAK=@, WHEN COMPLX 


fe 
50 FSIZ=SLZE+FADD 
ITEM=IFIX(FSIZ/RBLK+@. 5) 
LF (FLOAT (ITEM) *RBLK+@.5 .LT.FSIZ) ITEM=ITEM+1 
FBLK=FLOAT (ITEM) 
C FBLK IS MAXIMUM NUMBER OF 'RECDS', SIZE RBLK, POSSIBLE 
TBLK=FBLK 
IF(IRMF.GE.@)GO TO 60 
C GENERALLY TBLK=FBLK, BUT FOR PACKED REAL NOT SO, BELOW 
FSIZ=SIZE 
TBLK=FSIZ/RBLK 
Cc 
6¢ TDM1=1. 
RDM1=FSIZ 
IF(NDIM.EQ.1)GO TO 70 
C JOB COMPLETED IF NDIM=1 
Cc 
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C 


OTHERWISE COMPUTE TDM1 AS NUMBER OF 'RECDS', SIZE RDM1 REALS 


C 
70 DO 8@ I=1,11 


INT(I)=-1 
IF(VAL(L) .LE. FIXMAX) INT (I)=IFIX(VAL(1)+@.5) 
IF(INT(1I).LT.@.AND.MFPAR.EQ.0)MFPAR=-1 


80 CONTINUE 


C 


C 


CONVERT VALUES IN /MFVAL/ TO INTEGERS IN /MFINT/ (-1 IF TOO LARGE) 
RETURN 


90 IF (ICEX.GT .M+1) ICEX=M+1 


C 
C 


AANRAaNAgAaANAaAaaNnaanan 


enone) 


LF (IBEX.GT.ICEX-1) IBEX=ICEX~1 
LF (IBEX.LT.1)MFPAR=1 
GO TO 4¢ 
FORCES ICEX.NGT.M+l AND IBEX.NGT.ICEX-1, OR MFPAR=1 (IRMF=0) 


END 


SUBROUTINE DMPERM (MEXA,NDIM,NSHFT,IREX, BUFA, IBEX, ICEX) 


SHIFTS ORDER OF DIMENSIONS OF REAL OR COMPLEX MASS STORE ARRAY 
NOTE, THIS IS NOT USED BY FFT SUBRTNS BUT IS INCLUDED FOR COMPLETENESS 
(FRASER, ACM TOMS - 1978/79, AND J.ACM, V.23,N.2, APRIL 76, PP. 298-309) 


MEXA(J) LIST OF DIMENSION SIZE EXPONS (BASE 2), ADJACENT VARIABLES FIRST 
NDIM IS NUMBER OF EXPONENTS IN LIST AND THUS THE NUMBER OF DIMENSIONS 

SUM TO NDIM: MEXA(J)=M, WHERE 2**M IS SIZE OF MASS STORE ARRAY (SEE BELOW) 
NSHFT IS DIMENSION SHIFT COUNT, THUS: 

NSHFT=¢, NO SHIFT OR CHANGE OCCURS 

NSHFT=1,2 ETC., FIRST TO NEXT DIMENSION, CIRC NSHFT PLACE SHIFT (MOD NDIM) 
NSHFT=-1, REVERSES THE ORDER OF DIMENSIONS 

IREX=@ REAL, 1 COMPLEX (THAT IS, MOVEMENT GROUP IS 2**IREX REALS, 

AND TOTAL MASS STORE SIZE IS 2**(M+tIREX) REAL ELEMENTS) 


REAL BUFA(1) 
INTEGER MEXA(1) 


NS=MOD (NSHFT , NDIM) 
LF (NS .EQ.@) RETURN 
M=MFSUM(MEXA,NDIM, -1)+IREX 
FINDS M TOTAL AND REVERSES MEXA LIST 
CALL MFSORT(BUFA, IBEX, LCEX, [REX ,M,M) 
INITIAL OVERALL BIT-REVERSAL M BITS ABOVE IREX BITS 
IF(NSHFT.LT.@)GO TO 10 


BELOW, REVERSAL OF TWO PARTS, TO FORM REQUIRED SHIFT 
IH=MFSUM (MEXA ,NS ,-1)+IREX 
CALL MFSORT(BUFA, IBEX, ICEX, IREX, IH,M) 

REVERSE LOWER PART OF MEXA LIST AND LOWER PART OF ARRAY BITS 
CALL MFSORT(BUFA, IBEX, ICEX, IH,M,M) 

SEPARATELY REVERSE UPPER PART OF ARRAY BITS 
IH=MFSUM(MEXA (NSHFT+1) , NDIM-NS ,-1) 

REVERSE UPPER PART OF MEXA LIST 
RETURN 

RETURN FROM SUBROUTINE AFTER CYCLIC SHIFTS 


BELOW, SEPARATELY REVERSE OVER EACH DIMENSION (DIMEN REVERSAL) 


) ITH=IREX 


DO 26 J=1,NDIM 
IG=IH 
TH=IH+MEXA (J) 


20 CALL MFSORT(BUFA, IBEX, ICEX, 1G, IH,M) 


AANQDANAANM 


RETURN 


END 


THIS PROGRAM TESTS THE MASS STORE FFT BY COMPARISON WITH NAIVE DFT 
FFT PARAMETERS MAY BE ALTERED AT WILL (SEE COMMENTS) 

MASS STORE IS SIMULATED BY FORTRAN ARRAYS (SEE DUMMY I/0 SUBROUTINES) 

PRINTING MAY BE COPIOUS, OR ONLY MAX DIFFERENCES (SEE COMMENTS) 

TEST OK IF MAX DIFFERENCES ARE NEAR ORDER OF MACHINE ROUND-OFF 
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C 
C 


AQAAAAAANAA 


AaAAAAA 


aaa 


aaAaan 


DIFFERENT TYPE (REAL OR COMPLEX) FOR ARRAY BUFA. 


COMMON /MFARG/MEXA (4) ,NDIM, ISGN, IDIR, SCAL, IBEX, ICEX, IPAK 
COMMON/MFVAL/DIMA (4) , TDM1, RDM1, FBLK, TBLK, RBLK, RCOR, SIZE 
COMMON /MFINT/NDMA (4) ,NTD1,NRD1,NFBK ,NTBK,NRBK,NRCR,NSZE 


COMMON AREAS /MFARG/,/MFVAL/,/MFINT/ USEFUL FOR RUNNING MASS STORE FFT 
/MFARG/ HOLDS ARGUMENTS USED IN FFT CALLES, MOSTLY EXPONENTS 
HELPER ROUTINE MFPAR COMPUTES VALUES FROM /MFARG/ INTO 
/MFVAL/ (REALS AS SOME LARGE), /MFINT/ (INTEGER EQUIVALENTS IF POSS) 
OR CAN REVERSE-COMPUTE SOME /MFARG/ FROM /MFVAL/ 
SEE COMMENTS, ROUTINE MFPAR. 


COMMON /MASS /RMAS (14624) 

COMPLEX ANAIV(512) ,BNAIV(512) ,CBUFA(512) ,CDIF 
REAL RANDA(1@24) , BUFA(1024) 

EQUIVALENCE (CBUFA(1),BUFA(1)) 


COMMON/MASS/RMAS() USED BY ROUTINES MFREAD/MFWRIT TO SIMULATE MASS STORE 
ANAIV(), BNAIV() HOLD RESULT OF NAIVE DFT FOR COMPARISON 

BUFA ()=CBUFA() IS WORKING AREA IN CORE STORE FOR FFI AND PROGRAM 
RANDA HOLDS PSEUDO RANDOM DATA USED IN TEST 


LP=5 
IPRINT=@ 
LP IS PRINTER LOGICAL UNIT, IPRINT=+1 FOR COPIOUS PRINT, 
IPRINT=@ FOR MAX DIFFERENCES ONLY, -1 OVERALL MAX DIFFERENCE ONLY 


M=5 
M SETS THE OVERALL ARRAY SIZE FOR AUTO IBEX, ICEX,MEXA,NDIM STEPPING 
FIXED VALUES CAN BE USED (SEE COMMENTS BELOW DO 19@ STATEMENTS) 


IRMF=-1 
IRMF=-1 REAL ROUTINE RMFFT TEST, @ COMPLEX ROUTINE CMFFT TEST 


ISGN=-1 
IDIR=-1 
IPAK=1 
FFT ARGS, ISGN=+/- 1, IDIR=-1 (RMFFT), IDIR=1 OR @ (CMFFT) 
IPAK=1 OR @ (RMFFT), -1 GIVES APPARENT FAILURES DUE TO SQUEESED RESULT 


BELOW, PRINT HEADINGS FOR TEST OUTPUT 
IF(IPRINT.LE.@)WRITE(LP, 91@) IPRINT, IRMF 


916 FORMAT(31H1MASS STORE FFT TEST - IPRINT =,13, 


C 
C 


aa 


Qa 


16 


X 36H (1=COPIOUS,@=MAX DIFFS,-1=OVERALL*,, 
X 9H IRMF =,13,28H (@=CMFFT TEST,1=RMFFT TEST) /) 
DIFMG=9@. 


BELOW, DO 16@ COMPUTES ALL POSSIBLE MEXA FOR 1,2 AND 3 DIMENSIONS 
DO 10@ NDIM=1,3 
M2M=M-NDIM+1 
LF (NDIM.EQ.1)M2M=1 
DO 16¢@ M2=1,M2M 
M3M=M2M-M2+1 
LF (NDIM.NE. 3)M3M=1 
DO 1¢¢ M3=1,M3M 
LF (NDIM.EQ.1)MEXA(1)=M 
IF (NDIM.EQ. 2)MEXA(1)=M-M2 
IF (NDIM.EQ.3)MEXA(1)=M-M2-M3 
MEXA (2)=M2 
MEXA(3)=M3 
REPLACE DO 1¢@ SET BY FIXED MEXA LIST, IF DESIRED 


IBEX=2 
ICEX=4 
DUMMY IBEX, ICEX SO NO ERROR IN MFPAR BELOW 
LERR=MFPAR (IRMF , @) 
IF(IERR.NE.@)GO TO 19660 
CALL HELPER ROUTINE TO COMPUTE SIZES USED BY NAIVE DFT SUBRTN 


=MFSUM(MEXA,NDIM, 99) 
AR=RANMF (1) 
RESET RANDOM NUMBER GENERATOR AND COMPUTE M IN CASE NOT GIVEN 
DO 16 J=1,NSZE 
RANDA (J) =RANMF (-1) 
ANALV(J)=CMPLX(RANDA(J) ,@.) 
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C LOAD RANDOM NUMBERS FOR FFT AND FOR NAIVE SUBROUTINE 
C r 

CALL NALVE(ANAIV, BNALV,NDMA(1) ,NDMA(2) ,NDMA(3) , ISGN) 
C NAIVE DFT SUBROUTINE CALLED TO COMPUTE 'SLOW' FOURIER TRANSFORM 
C 
C 

IF (IRMF.EQ.@)GO TO 2@ 

C BELOW, SET LIMTS FOR STEPPING IBEX, ICEX, WHEN CALLING RMFFT 

IBEXL=2 

ICEXL=4 

ICEXM=M 

GO TO 3@ 
Cc 
C SETS DIFFERENT LIMITS FOR IBEX, ICEX FOR CMFFT BELOW (IRMF.EQ.@) 
20 IBEXL=1 

ICEXL=2 

ICEXM=M+1 


30 IF (ICEXL.GT.ICEXM)GO TO 160¢ 
DO 10@ ICEX=ICEXL, ICEXM 
IBEXM=ICEX-2 
LF (IRMF.EQ. 6) IBEXM=ICEX-1 
DO 1¢¢@ IBEX=IBEXL, IBEXM 
C IBEX AND ICEX COMPUTED; REPLACE DO 16@ ABOVE BY FIXED IBEX,ICEX IF REQUD. 


IERR=MFPAR (IRMF, 0) 
IF(LERR.NE.@)GO TO 1600 
NCNT=NRDL 
C HELPER ROUTN, NID1 TOTAL NUMB OF NRD1 REALS IN FIRST DIMENSION 
C  (NCNT IS NUMBER OF REAL ELMTS IN FIRST DIMENSTon) 
SCAL=1. 
IF(IRMF.EQ.%)GO TO 50 
C SWITCH FOR COMPLEX ROUTINE CMFFT AT 5@, REAL RMFFT BELOW 
C 
DO 4¢ JB=1,NTD1 
K=(JB-1) *NCNT 
DO 35 I=1,NCNT 
J=K+I 
35° BUFA(I)=RANDA(J) 
CALL MFWRIT(BUFA,NRD1, JB) 
40 CONTINUE 
C LOAD RANDOM NUMBERS IN REAL ARRAY IN 'RECDS' OF FIRST DIMEN LENGTH 
C (NOTE, THIS REQUIRES MFREAD/MFWRIT TO BE ABLE TO ACCEPT 'RECORDS' 
C OF DIFFERENT LENGTH; OTHERWISE MUST USE NTBK AND NRBK HERE) 
Cc 
CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C REAL MASS STORE ROUTINE RMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 
GO TO 76 
Cc 
C BELOW, USE COMPLEX ROUTINE CMFFT, NCNT NUM OF CMPLX ELMTS IN FIRST DIMEN 
56 NCNT=NCNT/ 2 
DO 6@ JB=1,NTD1 
K=(JB-1) *NCNT 
DO 55 I=1,NCNT 
J=K+1 
55 CBUFA(1)=CMPLX(RANDA(J) ,@.) 
CALL MFWRIT(BUFA,NRD1, JB) 
60 CONTINUE 
C LOAD REAL VALUES IN CMPLX ARRAY IN 'RECDS' OF FIRST DIMEN LENGTH 
C (NOTE, THIS REQUIRES MFREAD/MFWRIT TO BE ABLE TO ACCEPT 'RECORDS' 
C OF DIFFERENT LENGTH; OTHERWISE MUST USE NIBK AND NRBK HERE) 
C 
CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C COMPLEX MASS STORE ROUTINE CMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 
Cc 
7@ IF(IPRINT.LE.@)GO TO 75 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE (LP, 916) ITPRINT, IRMF 
WRITE(LP,920)NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
920 FORMAT(8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 10H MEXA() =,315) 
WRITE (LP, 930) 
930 FORMAT(8H INDEX,12X, 3HFFT, 24X, 5HNAIVE, 24x, 4HDIFF) 
Cc 
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75 LERR=MFPAR (-IRMF, @) 
IF(IERR.NE.@)GO TO 10606@ 
NCNT=NRD1 /2 
C HELPER ROUTN, NID1 TOTAL NUMB OF NRD1 REALS IN FIRST DIMENSION 
C (NOTE IRMF=+1 FOR DATA IN COMPLEX STATE, NCNT ELMTS) 
6 
C BELOW, COMPARES FFT COMPLEX RESULT WITH NAIVE RESULT 
DIFM=0. 
DO 8¢@ JB=1,NTD1 
K=(JB-1) *NCNT 
CALL MFREAD(BUFA,NRD1,JB) 
C READ 'RECDS' OF FIRST DIMEN LENGTH (RECOMPUTED ABOVE BY MFPAR) 
C (NOTE, THIS REQUIRES MFREAD/MFWRIT TO BE ABLE TO ACCEPT 'RECORDS' 
C OF DIFFERENT LENGTH; OTHERWISE MUST USE NTBK AND NRBK HERE) 
Cc 


DO 8¢ I=1,NCNT 
J=K+1 
INDEX=J-=1 
IF(IDIR.NE.@) CDIF=CBUFA(1L)-BNAIV(J) 
IF (IDIR.EQ.@)CDIF=CBUFA(I)-ANAIV (J) 
DIF=ABS (REAL (CDIF) ) 
IF (DIF.GT.DIFM)DIFM=DIF 
DIF=ABS (AIMAG (CDIF) ) 
IF (DIF.GT.DIFM)DIFM=DIF 
IF(IPRINT.LE.%)GO TO 80 
IF (IDIR.NE. 0) WRITE (LP ,94@) INDEX, CBUFA(I) ,BNAIV(J) ,CDIF 
IF(IDIR.EQ.@)WRITE (LP, 9406) INDEX, CBUFA(I) ,ANAIV(J) ,CDIF 
949  FORMAT(1X,15,3(2X,2E13.4)) 
80 CONTINUE 
C BELOW, PRINT INTERMEDIATE DIFFERENCES 
Cc 
IF (IPRINT.GE.@) WRITE (LP, 950)DIFM, NDIM, ISGN, IDIR, IBEX, ICEX,IPAK, 
X (MEXA(J),J=1,NDIM) 
95@  FORMAT(1@H MAX DIFF ,E11.4,1X, 
X 8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 1@H MEXA() =,315) 
IF (DIFM.GT.DIFMG) DIFMG=DIFM 


aa 


BELOW, INVERT ISGN AND IDIR FOR INVERSE TRANSFORM (COMPLEX-TO-REAL) 
ISGN=-ISGN 
IDIR=-IDIR 
SCAL=1./SIZE 
LF (IRMF.NE.@) 
X CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,<{BEX,ICEX, IPAK) 
EITHER ROUTINE RMFFT INVERSE TRANSFORMS ARRAY TO PACKED REAL 


io) 


IF (IRMF.EQ.¢) 
X CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, {BEX, ICEX) 
OR ROUTINE CMFFT INVERSE TRANSFORMS ARRAY 


aa 


IF(IPRINT.LE.@)GO TO 85 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE (LP,910) IPRINT, IRMF 
WRITE(LP , 920) NDIM, ISGN, IDIR, IBEX, ICEX, I[PAK, 
X (MEXA(J),J=1,NDIM) 
WRITE (LP, 960) 
960  FORMAT(8H INDEX, 4X, 8HFFT/2**M, 6X, 5SHINPUT,10X, 4HDIFF) 


85 LERR=MFPAR (IRMF, @) 
IF(IERR.NE.@)GO TO 16060 
NCNT=NRD1 
LF (IRMF .EQ.0@)NCNT=NCNT/2 
C HELPER ROUTN, NTD1 TOTAL NUMB OF NRD1 REALS IN FIRST DIMENSION 
Cc  (NCNT IS NUMBER OF ELMTS IN FIRST DIMENSION, REAL OR CMPLX) 
G 
C BELOW, COMPARES FFT INVERSE RESULT WITH INITIAL RANDOM INPUT 
DIFM=¢@. 
DO 9@ JB=1,NTD1 
K=(JB-1) *NCNT 
CALL MFREAD(BUFA,NRD1, JB) 
C READ 'RECDS' OF FIRST DIMEN LENGTH (RECOMPUTED ABOVE BY MFPAR) 
C (NOTE, THIS REQUIRES MFREAD/MFWRIT TO BE ABLE TO ACCEPT 'RECORDS' 
C OF DIFFERENT LENGTH; OTHERWISE MUST USE NTBK ANI) NRBK HERE) 
Cc 


DO 9% I=1,NCNT 


COLLECTED ALGORITHMS (cont.) 


J=K+I 

INDEX=J-1 

IF (IRMF.NE.@) RM=BUFA(I) 

IF (IRMF.EQ.@) RM=REAL (CBUFA(I) ) 

DIF=ABS (RM-RANDA (J) ) 

LF (DIF.GT.DIFM)DIFM=DIF 

IF(IPRINT.GT.@)WRITE (LP, 940) INDEX, RM, RANDA(J) ,DIF 
96 CONTINUE 


C PRINT INVERSE RESULTS (SHOULD BE SAME AS INITIAL RANDOM SET) 


C 


IF (IPRINT.GE.) WRITE (LP, 956)DIFM, NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 


X (MEXA(J),J=1,NDIM) 
IF (DIFM.GT.DIFMG) DIFMG=DIFM 
ISGN=-ISGN 
IDIR=-IDIR 
C RESTORE ISGN AND IDIR FOR FORWARD TRANSFORM 
16@ CONTINUE 
Cc 


C BELOW, PRINT OVERALL MAXIMUM DIFFERENCE 
WRITE (LP, 970) DIFMG,M, ISGN, IDIR, IPAK 
976 FORMAT(18H OVERALL MAX DIFF ,E11.4, 3X, 


X 48H FOR ALL MEXA(1 TO 3 DIM),IBEX,ICEX,MEXA FOR M =,13, 


X 19H, ISGN,IDIR(+/-) =,214,8H IPAK =,14) 
STOP 
C 
1606 WRITE(LP, 980) 1ERR 
98@ FORMAT(25H IBEX FORCED TOO SMALL OR, 
X  3@H NOT ALL /MFINT/ CORRECT, IERR,14) 
STOP 
END 


FUNCTION RANMF(J) 
Cc 
C RANDOM NUMBER GENERATOR FOR MASS STORE FFT TEST 
Cc 
IF(J.GE.¢)GO TO 2¢ 
C POSITIVE J CAUSES RESET OF INITIAL K 
C NEGATIVE J MUST BE USED NORMALLY 
C 
MODULO=29048 
FLMOD=2048 .@ 
DO 1@ I=1,15 
10 K=MOD (5*K, MODULO) 
Z=FLOAT (K) /FLMOD 


RANMF=Z 
RETURN 
C 
20 K=J 
RANMF=J 
RETURN 
C 
END 


SUBROUTINE NAIVE(ANAIV, BNAIV,NJ,NK,NL, ISGN) 


C 
C NAIVE DISCRETE FOURIER TRANSFORM - 1 TO 3 DIMENSIONS 


C USED TO TEST MASS STORE FFT, INPUT ARRAY ANAIV(NJ,NK,NL) 


C RESULT RETURNED IN BOTH ARRAYS ANAIV AND BNAIV 


C ANAIV DIMENSIONS IN INITIAL ORDER, BNAIV REVERSED ORDER 
C NJ,NK,NL DIMENSIONING, ISGN SIGN OF COMPLEX EXPONENT OF FOURIER 


C 
COMPLEX TEMP ,ANAIV(NJ,NK,NL) , BNAIV(NL,NK,NJ) 
DATA PI/3.141592653589793/ 
Cc 
PI2=PI*2.¢ 
IF(ISGN.LT.@)PI2=-P12 
C 


DO 20 JB=1,NJ 
AJB=FLOAT (JB-1) / FLOAT (NJ) 
DO 2@ KB=1,NK 
AKB=FLOAT (KB-1) / FLOAT (NK) 
DO 26 LB=1,NL 
ALB=FLOAT (LB-1) / FLOAT (NL) 
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TEMP=(@. ,@.) 

DO 10 JA=1,NJ 

AJA=FLOAT (JA-1) *AJB 
DO 10 KA=1,NK 

AKA=FLOAT (KA-1) *AKB 
DO 1@ LA=1,NL 

ALA=FLOAT (LA-1) *ALB 

16  ‘TEMP=TEMP+ANAIV(JA,KA, LA) *CEXP (CMPLX(@. ,P12* (AJA+AKA+ALA) ) ) 


20  BNALV(LB,KB,JB)=TEMP 


DO 3@ JA=1,NJ 
DO 3@ KA=1,NK 
DO 3¢@ LA=1,NL 
30 ANAIV(JA,KA,LA)=BNAIV(LA,KA, JA) 


RETURN 
C 

END 

SUBROUTINE MFREAD(BUFA, NB, JB) 
Cc 


C DUMMY SUBROUTINE TO SIMULATE RANDOM ACCESS MASS STORE READ 
C READ BLOCK, INDEX JB, FROM MASS STORE TO BUFA, NB REAL VALUES 
C COMMON ARRAY RMAS SIMULATES MASS STORE ARRAY 


Cc 
COMMON /MASS/RMAS (1624) 
REAL BUFA(NB) 
Cc 
IOF=(JB-1)*NB 
DO 1¢@ I=1,NB 
K=IOF+I 
10 BUFA(1I)=RMAS (K) 
RETURN 
C 
END 
SUBROUTINE MFWRIT(BUFA,NB, JB) 
Cc 


C DUMMY SUBROUTINE TO SIMULATE RANDOM ACCESS MASS STORE WRITE 
C WRITE BLOCK, INDEX JB, FORM BUFA TO MASS STORE, NE REAL VALUES 
C COMMON ARRAY RMAS SIMULATES MASS STORE ARRAY 


C 
COMMON /MASS/RMAS (1024) 
REAL BUFA(NB) 
Cc 
IOF=(JB-1) *NB 
DO 1@ I=1,NB 
K=IOF+I1 
10 RMAS (K)=BUFA (IL) 
RETURN 
C 
END 
PROGRAM MASTOM(TAPE1, INPUT, OUTPUT , TAPE6¢=INPUT , TAPES=OUTPUT) 
C 
C CONTROL DATA 6@@¢ AND CYBER MASS STORE I/O FFT TEST PROGRAM 
C 
C NOTE WELL THAT TYPE COMPLEX DATA MUST EXIST AS ALTERNATING 
C REAL/IMAG/REAL/IMAG... ELEMENTS, BOTH IN MASS STORE AND IN FORTRAN 
C WORKING ARRAY BUFA; IN THIS FFT, DIFFERENT SUBROUTINES WILL SET 
C DIFFERENT TYPE (REAL OR COMPLEX) FOR ARRAY BUFA. 
C 
C 
COMMON /FFTCOM/LUN , MINDX (512) 
C 
C COMMON /FFTCOM/ HOLDS LOGICAL UNIT NUMBER FOR MASS STORE 1/0 
C ARRAY MINDX HOLDS RECORD INDICES FOR CYBER MASS STORE I/O 
C 


COMMON/MFARG/MEXA(4) ,NDIM, ISGN, IDIR,SCAL, IBEX, ICEX, [PAK 
COMMON/MFVAL/DIMA (4) , TDM1,RDM1, FBLK, TBLK, RBLK, RCOR, SIZE 
COMMON /MFINT/NDMA (4) ,NTD1,NRD1,NFBK,NTBK,NRBK, NRCR,NSZE 
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COMMON AREAS /MFARG/,/MFVAL/,/MFINT/ USEFUL FOR RUNNING MASS STORE FFT 
/MFARG/ HOLDS ARGUMENTS USED IN FFT CALLES, MOSTLY EXPONENTS 
HELPER ROUTINE MFPAR COMPUTES VALUES FROM /MFARG/ INTO 
/MFVAL/ (REALS AS SOME LARGE), /MFINT/ (INTEGER EQUIVALENTS IF POSS) 
OR CAN REVERSE-COMPUTE SOME /MFARG/ FROM /MFVAL/ 
SEE COMMENTS, ROUTINE MFPAR. 
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COMPLEX CBUFA(4@96) 
REAL BUFA(8192) 
EQUIVALENCE (CBUFA(1) ,BUFA(1)) 


C 
C BUFA()=CBUFA() IS WORKING AREA IN CORE STORE FOR FFT AND PROGRAM 
Cc 


LUN=1 
C LUN IS LOGICAL UNIT FOR CYBER MASS STORE 1/0 
C 

LP=5 

IPRINT=@ 
C LP IS PRINTER LOGICAL UNIT, IPRINT=+1 COPIOUS, @ MAX DIFFERENCES ONLY 
C 

IRMF=-1 
C IRMF=-1 REAL ROUTINE RMFFT TEST, @ COMPLEX ROUTINE CMFFT TEST 
C 

ISGN=-1 

IDIR=-1 

IPAK=1 


FFT ARGS, ISGN=+/- 1, IDIR=-1 (RMFFT), IDIR=1 OR @ (CMFFT) 
IPAK=1, @ OR -1 (RMFFT), NOT USED (CMFFT) 


Maan 


BELOW, PRINT HEADINGS FOR TEST OUTPUT 
IF(IPRINT.LE.@)WRITE (LP , 9106) IPRINT, IRMF 
916 FORMAT(31H1MASS STORE FFT TEST - IPRINT =,13, 
X 25H (1=COPIOUS,@=MAX DIFFS),, 
X 9H IRMF =,13,28H (@=CMFFT TEST,1=RMFFT TEST) /) 
DIFMG=¢. 


MEXA(1)=8 
MEXA (2)=6 
NDIM=2 
IBEX=9 
ICEX=13 
MORE FFT ARGS, 2**8 ROWS OF 2**6 ELMTS, 2 DIMEN, 
FFT MASS STORE BLOCKS 2**IBEX REALS, BUFA 2**ICEX REALS 


aang 


IERR=MFPAR (IRMF, @) 

IF(IERR.NE.@)GO TO 1006¢ 

CALL OPENMS (LUN,MINDX,NFBK+1, 0) 
C CYBER 'READMS/WRITMS' MASS STORE OPENED WITH ‘NUM REC'+1=NFBK+1 
C (NOTE HELPER ROUTN MFPAR RETURNS NFBK AS MAXIMUM FILE SIZE) 
Cc 


NCNT=NRBK 
C HELPER ROUTINE, NCNT NUM OF ELMTS IN FFT BLOCK, NTBK TOTAL BLOCKS 
C 

M=MFSUM (MEXA, NDIM, 99) 

SCAL=1. 

VALU=0. 

VINC=1./SIZE 

IF(IRMF.EQ.@)GO TO 50 
C SWITCH FOR COMPLEX ROUTINE CMFFT AT 5@, REAL RMFFT BELOW 
C 


DO 4@ JB=1,NTBK 
DO 35 I=1,NCNT 
BUFA(L)=VALU 
35 VALU=VALU+VINC 
CALL MFWRIT (BUFA,NRBK, JB) 
4g CONTINUE 
C LOAD RAMP FUNCTN IN REAL ARRAY IN 'RECDS' OF NRBK LENGTH 
C (NOTE, CYBER MFREAD/MFWRIT (USING READMS/WRITMS) CANNOT ACCEPT 'RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 ‘RECDS' OF NRD1 HERE) 
Cc 
CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C REAL MASS STORE ROUTINE RMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 
GO TO 7¢ 
Cc 
C BELOW, USE COMPLEX ROUTINE CMFFT, NCNT NUM OF CMPLX ELMTS IN FFT BLOCK 
50 NCNT=NCNT/2 
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DO 6@ JB=1,NTBK 
DO 55 I=1,NCNT 
CBUFA(1L)=CMPLX (VALU, @. ) 
55 VALU=VALU+VINC 
CALL MFWRIT(BUFA, NRBK,JB) 
60 CONTINUE 
C LOAD RAMP FUNCTN IN COMPLEX ARRAY IN 'RECDS' OF NRBK LENGTH 
C (NOTE, CYBER MFREAD/MFWRIT (USING READMS/WRITMS) CANNOT ACCEPT 'RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 'RECDS' OF NRD1 HERE) 
Cc 
CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C COMPLEX MASS STORE ROUTINE CMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 
Cc 
70 IF(IPRINT.LE.@)GO TO 75 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE(LP, 910) IPRINT, [RMF 
WRITE (LP, 920)NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
92@  FORMAT(8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 1@H MEXA() =, 315) 
WRITE (LP, 930) 
93@ FORMAT(8H INDEX,12X, 3HFFT) 


IERR=MFPAR (-IRMF, 0) 
IF(IERR.NE.@)GO TO 1000 
NCNT=NRBK/ 2 
C HELPER ROUTN, NTBK TOTAL NUMB OF NRBK REALS IN FFT BLOCK 
C (NOTE IRMF=+1 FOR DATA IN COMPLEX STATE, NCNT ELMTS) 
Cc 
C BELOW, PROGRAM CAN ACCESS FFT COMPLEX RESULT (AND FORM COMPARISON, IF KNOWN) 
DO 8@ JB=1,NTBK 
K=(JB-1) *NCNT 
CALL MFREAD (BUFA,NRBK, JB) 
C READ 'RECDS' OF NRBK LENGTH, TOTALLING NTBK (RECOMPUTED BY MFPAR) 
C (NOTE, CYBER MFREAD/MFWRIT (USING READMS/WRITMS) CANNOT ACCEPT 'RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 'RECDS' OF NRD1 HERE) 
Cc 


DO 8@ I=1,NCNT 
INDEX=J-1 
IF(IPRINT.LE.%)GO TO 8¢@ 
WRITE (LP, 940) INDEX, CBUFA(I) 
949 FORMAT(1X,15,2X,2E13.4) 
80 CONTINUE 
Cc 
C BELOW, INVERT ISGN AND IDIR FOR INVERSE TRANSFORM (COMPLEX-TO-REAL) 
75 ISGN=-ISGN 
LDIR=-IDIR 
SCAL=1./SIZE 
LF (IRMF .NE.@) 
X CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C EITHER ROUTINE RMFFT INVERSE TRANSFORMS ARRAY TO PACKED REAL 
Cc 
LF(IRMF.EQ.@) 
X CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C OR ROUTINE CMFFT INVERSE TRANSFORMS ARRAY 
Cc 
IF(IPRINT.LE.@)GO TO 85 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE (LP, 910) IPRINT, [RMF 
WRITE (LP, 926) NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
WRITE (LP, 960) 
96@ FORMAT(8H INDEX, 4X, 8HFFT/2**M, 6X, 5SHINPUT, 10X, 4HDIFF) 


85 LERR=MFPAR(IRMF, @) 
IF(IERR.NE.@)GO TO 1606 
NCNT=NRBK 
IF(IRMF.EQ.@)NCNT=NCNT/ 2 
C HELPER ROUTN, NTBK TOTAL NUMB OF NRBK REALS IN FFT BLOCK 
C  (NCNT IS NUMBER OF ELMTS IN FFT BLOCK, REAL OR CMPLX) 
C 
C BELOW, COMPARES FFT INVERSE RESULT WITH INITIAL RANDOM INPUT 
DIFM=@. 
VALU=@. 
DO 90 JB=1,NTBK 


COLLECTED ALGORITHMS (cont.) 


CALL MFREAD(BUFA, NRBK, JB) 
C READ 'RECDS' OF NRBK LENGTH, TOTALLING NTBK (RECOMPUTED BY MFPAR) 


C (NOTE, CYBER MFREAD/MFWRIT (USING. READMS/WRITMS) CANNOT ACCEPT ‘RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 'RECDS' OF NRD1 HERE) 
C 


DO 9@ I=1,NCNT 
IF (IRMF .NE.@)RM=BUFA(L) 
IF (IRMF.EQ.@) RM=REAL (CBUFA(L)) 
DIF=ABS (RM-VALU) 
IF (DIF.GT.DIFM) DIL FM=DIF 
IF (IPRINT.GT.@)WRITE (LP ,996)1,RM, VALU, DIF 
999 FORMAT(1X,1I5,3(2X,E13.4)) 
VALU=VALU+VINC 
96 CONTINUE 
C PRINT INVERSE RESULTS (SHOULD BE SAME AS INITIAL RAMP) 
Cc 
IF (IPRINT.GE.@)WRITE (LP, 95@)DIFM,NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
95@  FORMAT(1@H MAX DIFF ,E11.4,1X, 
X 8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 1@H MEXA() =,315) 
IF (DIFM.GT.DIFMG)DIFMG=DIFM 
Cc 
STOP 
Cc 
100% WRITE(LP,98@) IERR 
980 FORMAT(25H IBEX FORCED TOO SMALL OR, 
X 30H NOT ALL /MFINT/ CORRECT, IERR;14) 
STOP 
END 


SUBROUTINE MFREAD(BUFA,NB, JB) 
CONTROL DATA 60@¢6 AND CYBER MASS STORE I/O ROUTINES FOR FFT 
(LOGICAL UNIT LUN IN COMMON/FFTCOM/ MUST HAVE BEEN OPENED 
PREVIOUSLY; EG. CALL OPENMS (LUN, INDXARRAY , NREC+1, @) 


WHERE NREC=2**(M-IBEX+1) IF IPAK=1 OR LESS IF IPAK=@ OR -1) 


SEE ALSO ALTERNATIVE SUBROUTINES USING EXTENDED CORE OR LCM 
(IN ADDITION, GETW, PUTW OR READM, WRITEM MACROS CAN BE USED) 


READ BLOCK, INDEX JB, FROM MASS STORE TO BUFA, NB REAL VALUES 


AAANQTAAQAAAANAARAAN 


COMMON / FFTCOM/LUN , MINDX (512) 
REAL BUFA(NB) 


CALL READMS (LUN, BUFA,NB,JB) 
RETURN 


ENTRY MFWRIT 
WRITE BLOCK, INDEX JB, FROM BUFA TO MASS STORE, NB REAL VALUES 


aa 


CALL WRITMS (LUN,BUFA,NB,JB,-1,@) 
RETURN 


END 


PROGRAM LCMTOM(INPUT , OUTPUT , TAPE6Q=INPUT , TAPE5=OUTPUT) 
CONTROL DATA 6¢@¢ AND CYBER EXTENDED CORE/LCM FFT TEST PROGRAM 


NOTE WELL THAT TYPE COMPLEX DATA MUST EXIST AS ALTERNATING 
REAL/IMAG/REAL/IMAG... ELEMENTS, BOTH IN MASS STORE AND IN FORTRAN 
WORKING ARRAY BUFA; IN THIS FFT, DIFFERENT SUBROUTINES WILL SET 
DIFFERENT TYPE (REAL OR COMPLEX) FOR ARRAY BUFA. 


aaanaanaNnaAa 


LEVEL 3, LBUFA 
COMMON / FFTCOM/LBUFA (32768) 


a 


C LBUFA IN EXTENDED CORE/LCM SIMULATES FAST MASS STORE 
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C DIMENSION LBUFA AS LARGE AS NECESSARY FOR RESULTANT ARRAY 
C 
COMMON /MFARG/MEXA(4) ,NDIM, ISGN, IDIR, SCAL, IBEX, 1CEX, IPAK 
COMMON/MFVAL/DIMA (4) , TDM1,RDM1, FBLK, TBLK, RBLK,RCOR, SIZE 
COMMON /MFINT/NDMA (4) ,NTD1,NRD1,NFBK,NTBK ,NRBK ,NRCR,NSZE 


Cc 
C COMMON AREAS /MFARG/,/MFVAL/,/MFINT/ USEFUL FOR RUNNING MASS STORE FFT 
C /MFARG/ HOLDS ARGUMENTS USED IN FFT CALLES, MOSTLY EXPONENTS 
C HELPER ROUTINE MFPAR COMPUTES VALUES FROM /MFARG/ INTO 
C /MFVAL/ (REALS AS SOME LARGE), /MFINT/ (INTEGER EQUIVALENTS IF POSS) 
Cc OR CAN REVERSE-COMPUTE SOME /MFARG/ FROM /MFVAL/ 
Cc SEE COMMENTS, ROUTINE MFPAR. 
C 
COMPLEX CBUFA (4096) 
REAL BUFA(8192) 
EQUIVALENCE (CBUFA(1) ,BUFA(1)) 
C 
C BUFA()=CBUFA() IS WORKING AREA IN CORE STORE FOR FFT AND PROGRAM 
Cc 
LP=5 
LPRINT=@ 


C LP IS PRINTER LOGICAL UNIT, IPRINT=+1 COPIOUS, @ MAX DIFFERENCES ONLY 
C 
IRMF=-1 
C IRMF=-1 REAL ROUTINE RMFFT TEST, @ COMPLEX ROUTINE CMFFT TEST 
C 
ISGN=-1 
IDIR=-1 
IPAK=1 
C FFT ARGS, ISGN=+/- 1, IDIR=-1 (RMFFT), IDIR=1 OR @ (CMFFT) 
C IPAK=1, @ OR -1 (RMFFT), NOT USED (CMFFT) 
C 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
LF (IPRINT.LE.@)WRITE(LP, 910) IPRINT, IRMF 
91@ FORMAT(31HIMASS STORE FFT TEST - IPRINT =,13, 
X 25H (1=COPIOUS,@=MAX DIFFS),, 
X 9H  IRMF =,13,28H (O=CMFFT TEST,1=RMFFT TEST) /) 
DIFMG=6. 


MEXA(1)=8 
MEXA(2)=6 
NDIM=2 
IBEX=7 
ICEX=13 
C MORE FFT ARGS, 2**8 ROWS OF 2**6 ELMTS, 2 DIMEN, 
C FFT MASS STORE BLOCKS 2**IBEX REALS, BUFA 2**ICEX REALS 
Cc 
TERR=MFPAR (IRMF , @) 
IF(IERR.NE.@)GO TO 1000 
NCNT=NRD1 
C HELPER ROUTINE, NCNT NUM OF ELMTS IN FIRST DIMEN, NTD1 TOTAL 
C 
M=MFSUM(MEXA, NDIM, 99) 
SCAL=1. 
VALU=0. 
VINC=1./SIZE 
IF(IRMF.EQ.0)GO TO 5@ 
C SWITCH FOR COMPLEX ROUTINE CMFFT AT 5@, REAL RMFFT BELOW 
C 
DO 4@ JB=1,NTD1 
DO 35 I=1,NCNT 
BUFA(L)=VALU 
35 VALU=VALU+VINC 
CALL MFWRIT(BUFA,NRD1, JB) 
40 CONTINUE 
C LOAD RAMP FUNCTN IN REAL ARRAY IN 'RECDS' OF NRD1 LENGTH 
C (NOTE, 'LCM' MFREAD/MFWRIT CAN ACCEPT 'RECORDS' OF DIFFERENT LENGTH; 
C SO CAN USE NTD1,NRD1 HERE INSTEAD OF NTBK,NRBK AS IN CYBER MASS STORE) 
Cc 
CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C REAL MASS STORE ROUTINE RMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 
GO TO 7@¢ 
Cc 
C BELOW, USE COMPLEX ROUTINE CMFFT, NCNT NUM OF CMPLX ELMTS IN FFT BLOCK 
50 NCNT=NCNT / 2 
DO 6¢ JB=1,NTD1 
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DO 55 I=1,NCNT 
CBUFA(I)=CMPLX(VALU,@. ) 
55. VALU=VALU+VINC 
CALL MFWRIT(BUFA,NRD1, JB) 
6@ CONTINUE 
C LOAD RAMP FUNCTN IN COMPLEX ARRAY IN 'RECDS' OF NRD1 LENGTH 
C (NOTE, 'LCM' MFREAD/MFWRIT CAN ACCEPT 'RECORDS' OF DIFFERENT LENGTH; 
C SO CAN USE NID1,NRD1 HERE INSTEAD OF NIBK,NRBK AS IN CYBER MASS STORE) 
C 
CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C COMPLEX MASS STORE ROUTINE CMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 


Cc 

70 IF(IPRINT.LE.@)GO TO 75 

C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE(LP,91@)IPRINT,IRMF - 
WRITE (LP, 920) NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 

92@ FORMAT(8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 10H MEXA() =,315) 
WRITE (LP, 930) 

939 FORMAT(8H INDEX,12X, 3HFFT) 


IERR=MFPAR (-LRMF, 0) 
IF(IERR.NE.@)GO TO 16060 
NCNT=NRD1/2 
C HELPER ROUTINE, NCNT NUM OF ELMTS IN FIRST DIMEN, NTD1 TOTAL 
C (NOTE IRMF=+1 FOR DATA IN COMPLEX STATE, NCNT ELMTS) 
Cc 
C BELOW, PROGRAM CAN ACCESS FFT COMPLEX RESULT (AND FORM COMPARISON, IF KNOWN) 
DO 8¢@ JB=1,NTD1 
K=(JB-1) *NCNT 
CALL MFREAD(BUFA,NRD1,JB) 
C READ 'RECDS' OF NRD1 LENGTH, TOTALLING NTD1 (RECOMPUTED BY MFPAR) 
C (NOTE, 'LCM' MFREAD/MFWRIT CAN ACCEPT 'RECORDS' OF DIFFERENT LENGTH; 
C SO CAN USE NTD1,NRD1 HERE INSTEAD OF NTBK,NRBK AS IN CYBER MASS STORE) 
Cc 


DO 86 I=1,NCNT 
INDEX=J-1 
IF(IPRINT.LE.@)GO TO 8@ 
WRITE (LP, 940) INDEX, CBUFA(1) 
940 FORMAT(1X,15,2X,2E13.4) 
80 CONTINUE 
Cc 
C BELOW, INVERT ISGN AND IDIR FOR INVERSE TRANSFORM (COMPLEX-TO-REAL) 
75 ISGN=-LISGN 
IDIR=-IDIR 
SCAL=1./SIZE 
IF (IRMF.NE.@) 
X CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C EITHER ROUTINE RMFFT INVERSE TRANSFORMS ARRAY TO PACKED REAL 
Cc 
IF (LRMF.EQ.@) 
X CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C OR ROUTINE CMFFT INVERSE TRANSFORMS ARRAY 
Cc 
IF(IPRINT.LE.@)GO TO 85 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE(LP, 910) ILPRINT, IRMF 
WRITE (LP, 926) NDIM, ISGN, IDIR, IBEX, LCEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
WRITE (LP, 96@) 
96¢  FORMAT(8H INDEX, 4X, SHFFT/2**M, 6X, SHINPUT, 10X, 4HDIFF) 


85 LERR=MFPAR (IRMF, 0) 

IF(IERR.NE.@)GO TO 16060 

NCNT=NRD1 

IF (IRMF.EQ. 6) NCNT=NCNT/2 
C HELPER ROUTINE, NCNT NUM OF ELMTS IN FIRST DIMEN, NTD1 TOTAL 
C  (NCNT IS NUMBER OF ELMTS IN FFT BLOCK, REAL OR CMPLX) 


Cc 

C BELOW, COMPARES FFT INVERSE RESULT WITH INITIAL RANDOM INPUT 
DIFM=@. 
VALU=@. 


DO 9% JB=1,NTD1 
CALL MFREAD(BUFA,NRD1, JB) 


COLLECTED ALGORITHMS (cont.) 


C 


C 
C 
C 


99 
99 


C 
C 


95 


C 


C 


READ 'RECDS' OF NRD1 LENGTH, TOTALLING NTD1 (RECOMPUTED BY MFPAR) 
(NOTE, 'LCM' MFREAD/MFWRIT CAN ACCEPT ‘RECORDS’ OF DIFFERENT LENGTH; 
SO CAN USE NTD1,NRD1 HERE INSTEAD OF NTBK,NRBK AS IN CYBER MASS STORE) 


DO 9@ I=1,NCNT 
LF (IRMF.NE.@) RM=BUFA (I) 
LF (IRMF.EQ.@)RM=REAL (CBUFA(I) ) 
DIF=ABS (RM-VALU) 
LF(DIF.GT.DIFM) DIFM=DIF 
IF (IPRINT.GT.@)WRITE(LP, 996)1,RM, VALU,DIF 
@  FORMAT(1X,I5,3(2X,E13.4)) 
VALU=VALU+VINC 
CONTINUE 
PRINT INVERSE RESULTS (SHOULD BE SAME AS INITIAL RAMP) 


IF (IPRINT.GE.@)WRITE (LP, 950) DIFM, NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J) ,J=1,NDIM) 
@  FORMAT(1@H MAX DIFF ,E11.4,1X, 
X 8H NDIM =,13,8H ISGN =,13,8H IDIR =,I 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,I 
X 1@H MEXA() =, 315) 
IF (DIFM.GT.DIFMG)DIFMG=DIFM 


3, 
3 


STOP 


1000 WRITE(LP, 980) IERR 
986 FORMAT(25H IBEX FORCED TOO SMALL OR, 


OO GOS Oa a 


Cc 


OTaroeOme oo 


aaa 


Xx 3@H NOT ALL /MFINT/ CORRECT, IERR,14) 
STOP 
END 


SUBROUTINE MFREAD (BUFA,NB, JB) 
CONTROL DATA 6000 AND CYBER EXTENDED CORE STORE 1/0 ROUTINES FOR FFT 


(EXTENDED CORE OR LCM TAKES PLACE OF MASS STORE - 
DIMENSION LBUFA AS LARGE AS NECESSARY FOR LARGE ARRAYS) 


ALTERNATIVELY, EXTENDED CORE USE COULD BE COMBINED WITH 
READM/WRITEM MACROS TO ACCESS LARGER FILE WHEN NECESSARY 
(USE VIRTUAL MEMORY ALGORITHM - MANY SECTORS HELD IN 
EXTENDED CORE AND ONLY ACCESSED FROM DISC IF NOT PRESENT). 

READ BLOCK, INDEX JB, FROM EXTENDED CORE TO BUFA, NB REAL VALUES 

LEVEL 3, LBUFA 

COMMON / FFTCOM/LBUFA (32768) 

REAL BUFA(NB) 


CALL MOVLEV (LBUFA((JB-1)*NB+1) , BUFA,NB) 
RETURN 


ENTRY MFWRIT 
WRITE BLOCK, INDEX JB, FROM BUFA TO EXTENDED CORE, NB REAL VALUES 


CALL MOVLEV(BUFA, LBUFA ((JB-1) *NB+1) , NB) 
RETURN 


END 


PDP 11 MASS STORE I/O FFT SAMPLE TEST PROGRAM 
NOTE WELL THAT TYPE COMPLEX DATA MUST EXIST AS ALTERNATING 
REAL/IMAG/REAL/IMAG... ELEMENTS, BOTH IN MASS STORE AND IN FORTRAN 
WORKING ARRAY BUFA; IN THIS FFT, DIFFERENT SUBROUTINES WILL SET 
DIFFERENT TYPE (REAL OR COMPLEX) FOR ARRAY BUFA. 
COMMON/ FFTCOM/LUN 


COMMON /FFTCOM/ HOLDS LOGICAL UNIT NUMBER FOR MASS STORE I/0 
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COMMON /MFARG/MEXA (4) ,NDIM, ISGN, IDIR,SCAL, IBEX, ICEX, IPAK 
COMMON/MFVAL/DIMA(4) ,TDM1,RDM1, FBLK, TBLK, RBLK, RCOR, SIZE 
COMMON /MFINT/NDMA (4) ,NTD1,NRD1,NFBK, NTBK,NRBK ,NRCR,NSZE 


Cc 
C COMMON AREAS /MFARG/,/MFVAL/,/MFINT/ USEFUL FOR RUNNING MASS STORE FFT 
C. /MFARG/ HOLDS ARGUMENTS USED IN FFT CALLES, MOSTLY EXPONENTS 
Cc HELPER ROUTINE MFPAR COMPUTES VALUES FROM /MFARG/ INTO 
C /MFVAL/ (REALS AS SOME LARGE), /MFINT/ (INTEGER EQUIVALENTS IF POSS) 
C OR CAN REVERSE-COMPUTE SOME /MFARG/ FROM /MFVAL/ 
c SEE COMMENTS, ROUTINE MFPAR. 
C 

COMPLEX CBUFA(1@24) 

REAL BUFA(2@48) 

EQUIVALENCE (CBUFA(1) ,BUFA(1)) 
Cc 


C BUFA()=CBUFA() IS WORKING AREA IN CORE STORE FOR FFT AND PROGRAM 


LUN=1 
C LUN IS LOGICAL UNIT FOR PDP 11 MASS STORE I/O 
Cc 

LP=5 

IPRINT=@ 


C LP IS PRINTER LOGICAL UNIT, IPRINT=+1 COPIOUS, @ MAX DIFFERENCES ONLY 


IRMF=-1 
C IRMF=-1 REAL ROUTINE RMFFT TEST, @ COMPLEX ROUTINE CMFFT TEST 
Cc 


ISGN=-1 

IDIR=-1 

IPAK=1 
FFT ARGS, ISGN=+/- 1, IDIR=-1 (RMFFT), IDIR=1 OR @ (CMFFT) 
IPAK=1, @ OR -1 (RMFFT), NOT USED (CMFFT) 


OO Ce 


BELOW, PRINT HEADINGS FOR TEST OUTPUT 
LF (IPRINT.LE.@)WRITE(LP, 910) IPRINT, [RMF 
916 FORMAT(31H1MASS STORE FFT TEST - IPRINT =,13, 
X 25H (1=COPIOUS,@=MAX DIFFS),, 
X 9H  IRMF =,13,28H (@=CMFFT TEST,1=RMFFT TEST) /) 
DIFMG=6. 


MEXA(1)=8 
MEXA(2)=6 
NDIM=2 
IBEX=7 
ICEX=11 
C MORE FFT ARGS, 2**8 ROWS OF 2**6 ELMTS, 2 DIMEN, 
C FFT MASS STORE BLOCKS 2**IBEX REALS, BUFA 2**ICEX REALS 
c 
TERR=MFPAR (IRMF, 0) 
IF(IERR.NE.@)GO TO 16060 
CALL ASSIGN(LUN, 'FFTEST.DAT' , 0): 
NWD=NRBK*2 
DEFINE FILE LUN(NFBK,NWD,U, INDX) 
C PDP 11 MASS STORE OPENED WITH NUM REC=NFBK, NRBK*2 WORDS PER REC 
C (NOTE HELPER ROUTN MFPAR RETURNS NFBK AS MAXIMUM FILE SIZE) 
Cc 
NCNT=NRBK 
C HELPER ROUTINE, NCNT NUM OF ELMTS IN FFT BLOCK, NTBK TOTAL BLOCKS 
Cc 
M=MFSUM (MEXA,NDIM, 99) 
SCAL=1. 
VALU=0. 
VINC=1./SIZE 
IF(IRMF.EQ.@)GO TO 5@ 
C SWITCH FOR COMPLEX ROUTINE CMFFT AT 5@, REAL RMFFT BELOW 
Cc 
DO 4@ JB=1,NTBK 
DO 35 I=1,NCNT 
BUFA(1)=VALU 
35 VALU=VALU+VINC 
CALL MFWRIT(BUFA,NRBK, JB) 
46 CONTINUE 
C LOAD RAMP FUNCTN IN REAL ARRAY IN 'RECDS' OF NRBK LENGTH 
C (NOTE, PDP 11 MFREAD/MFWRIT (USING FORTRAN I/0) CANNOT ACCEPT 'RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 'RECDS' OF NRD1 HERE) 
Cc i 
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CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C REAL MASS STORE ROUTINE RMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 
GO TO 76 
Cc 
C BELOW, USE COMPLEX ROUTINE CMFFT, NCNT NUM OF CMPLX ELMTS IN FFT BLOCK 
5@ NCNT=NCNT/2 
DO 6@ JB=1,NTBK 
DO 55 I=1,NCNT 
CBUFA(1I)=CMPLX (VALU, @.) 
55 VALU=VALU+VINC 
CALL MFWRIT(BUFA,NRBK, JB) 
60 CONTINUE 
C LOAD RAMP FUNCTN IN COMPLEX ARRAY IN 'RECDS' OF NRBK LENGTH 
C (NOTE, PDP 11 MFREAD/MFWRIT (USING FORTRAN I/0) CANNOT ACCEPT 'RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 'RECDS' OF NRD1 HERE) 
C 
, CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C COMPLEX MASS STORE ROUTINE CMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 


Cc 

70 IF(IPRINT.LE.@)GO TO 75 

C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE (LP, 910) IPRINT, IRMF 
WRITE (LP, 92@)NDIM, ISGN, IDIR, IBEX, ICEX, LPAK, 
X (MEXA(J) ,J=1,NDIM) 

926 FORMAT(8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 10H MEXA() =, 315) 
WRITE (LP, 930) 

93@  FORMAT(8H INDEX,12X, 3HFFT) 


ITERR=MFPAR (-IRMF, 0) 
IF(IERR.NE.@)GO TO 100¢ 
IF (IERR.NE.@)GO TO 1600 
NCNT=NRBK/2 
C HELPER ROUTN, NIBK TOTAL NUMB OF NRBK REALS IN FFT BLOCK 
C (NOTE IRMF=+1 FOR DATA IN COMPLEX STATE, NCNT ELMTS) 
Cc 
C BELOW, PROGRAM CAN ACCESS FFT COMPLEX RESULT (AND FORM COMPARISON, IF KNOWN) 
DO 8¢ JB=1,NTBK 
K= (JB-1) *NCNT 
CALL MFREAD(BUFA,NRBK, JB) 
C READ 'RECDS' OF NRBK LENGTH, TOTALLING NTBK (RECOMPUTED BY MFPAR) 
C (NOTE, PDP 11 MFREAD/MFWRIT (USING FORTRAN I/O) CANNOT ACCEPT 'RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 'RECDS' OF NRD1 HERE) 
C 
DO 8@ I=1,NCNT 
INDEX=J-1 
IF(IPRINT.LE.@)GO TO 8¢@ 
WRITE(LP, 94¢) INDEX, CBUFA(I) 
940 FORMAT(1X,15,2X, 2E13.4) 
80 CONTINUE 
C 
C BELOW, INVERT ISGN AND IDIR FOR INVERSE TRANSFORM (COMPLEX-TO-REAL) 
75 ISGN=-ISGN 
IDIR=-IDIR 
SCAL=1./SIZE 
IF (IRMF.NE.@) 
X CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C EITHER ROUTINE RMFFT INVERSE TRANSFORMS ARRAY TO PACKED REAL 
G 
IF (IRMF.EQ.@) 
X CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C OR ROUTINE CMFFT INVERSE TRANSFORMS ARRAY 
Cc 
IF(IPRINT.LE.@)GO TO 85 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE (LP, 910) IPRINT , IRMF 
WRITE (LP, 926) NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
WRITE (LP, 960) 
966  FORMAT(8H INDEX, 4X, SHFFT/2**M, 6X, SHINPUT, 16X, 4HDIFF) 


85 TERR=MFPAR (IRMF, 0) 
IF(IERR.NE.@)GO TO 1¢6¢¢ 
NCNT=NRBK 
IF (IRMF.EQ.@)NCNT=NCNT/2 
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C HELPER ROUTN, NTBK TOTAL NUMB OF NRBK REALS IN FFT BLOCK 
C  (NCNT IS NUMBER OF ELMTS IN FFT BLOCK, REAL OR CMPLX) 
Cc 
C BELOW, COMPARES FFT INVERSE RESULT WITH INITIAL RANDOM INPUT 
DLFM=@. 
VALU=¢. 
DO 9¢ JB=1,NTBK 
CALL MFREAD(BUFA,NRBK, JB) 
C READ 'RECDS' OF NRBK LENGTH, TOTALLING NTBK (RECOMPUTED BY MFPAR) 
C (NOTE, PDP 11 MFREAD/MFWRIT (USING FORTRAN I/0) CANNOT ACCEPT 'RECDS' 
C OF DIFFERENT LENGTH; OTHERWISE COULD USE NTD1 'RECDS' OF NRD1 HERE) 
Cc 
DO 9¢ I=1,NCNT 
IF (IRMF.NE.@) RM=BUFA (I) 
IF (IRMF.EQ.@) RM=REAL (CBUFA(I) ) 
DIF=ABS (RM-VALU) 
IF (DIF.GT.DIFM) DIFM=DIF 
IF(IPRINT.GT.0@)WRITE(LP, 996)1,RM, VALU, DIF 
999 FORMAT(1X,15,3(2X,E13.4)) 
VALU=VALU+VINC 
96 CONTINUE 
C PRINT INVERSE RESULTS (SHOULD BE SAME AS INITIAL RAMP) 
Cc 
IF (IPRINT.GE.@) WRITE (LP, 950) DIFM, NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
95@  FORMAT(1@H MAX DIFF ,E11.4,1X, 
X 8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 1@H MEXA() =,315) 
IF (DIFM.GT.DIFMG) DIFMG=DIFM 
Cc 
STOP 
Cc 
1000 WRITE(LP,98@)IERR 
980 FORMAT(25H IBEX FORCED TOO SMALL OR, 
X 3@H NOT ALL /MFINT/ CORRECT, IERR,I4) 
STOP 
END 


SUBROUTINE MFREAD(BUFA,NB, JB) 
PDP 11 FORTRAN DIRECT ACCESS READ ROUTINE FOR FFT 
(LOGICAL UNIT LUN IN COMMON/FFTCOM/ MUST HAVE BEEN OPENED 
PREVIOUSLY; EG. CALL ASSIGN(LUN, ‘FILENAME ',@) 
AND DEFINE FILE LUN(NREC,NWD,U, INDX) 
WHERE NWD=2**(IBEX+1) AND NREC=2**(M-IBEX+1) OR LESS IF IPAK=@ OR -1) 


SEE ALSO ALTERNATIVE, FAST MACRO I/O SUBROUTINES 
(THESE ARE TO BE PREFERRED, SINCE SPEED 2 TO 1@ TIMES BETTER) 


READ BLOCK, INDEX JB, FROM MASS STORE TO BUFA, NB REAL VALUES 


ARANRQRAANAANANANAAaAA 


COMMON/FFTCOM/LUN 
REAL BUFA(NB) 


READ (LUN' JB) BUFA 
RETURN 


END 


SUBROUTINE MFWRIT(BUFA,NB, JB) 
PDP 11 FORTRAN DIRECT ACCESS WRITE ROUTINE FOR FFT 


(LOGICAL UNIT LUN IN COMMON/FFTCOM/ MUST HAVE BEEN OPENED 

PREVIOUSLY; EG. CALL ASSIGN(LUN, ‘FILENAME’, @) 

AND DEFINE FILE LUN(NREC,NWD,U, INDX) 

WHERE NWD=2**(IBEX+1) AND NREC=2**(M-IBEX+1) OR LESS IF IPAK=@ OR -1) 


SEE ALSO ALTERNATIVE, FAST MACRO I/O SUBROUTINES 
(THESE ARE TO BE PREFERRED, SINCE SPEED 2 TO 1@ TIMES BETTER) 


aqaaqgaggqagaaangaa 
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Cc 
Cc 


Aaa Ot) 02 Oe OO OS 


OaAaQAaNAaAAAA 


WRITE BLOCK, INDEX JB, FROM BUFA TO MASS STORE, NB REAL VALUES 


COMMON / FFTCOM/LUN 
REAL BUFA(NB) 


WRITE (LUN'JB)BUFA 
RETURN 


END 


PDP 11 FAST MACRO I/O FFT SAMPLE TEST PROGRAM 
(REQUIRES CALL TO SYSTEM MACRO TO OPEN FILE FOR I/0 - SEE LINE 70) 


NOTE THAT FAST MACRO I/O IS MORE EFFEICIENT THAN STANDARD FORTRAN I/O 


NOTE WELL THAT TYPE COMPLEX DATA MUST EXIST AS ALTERNATING 
REAL/IMAG/REAL/IMAG... ELEMENTS, BOTH IN MASS STORE AND IN FORTRAN 
WORKING ARRAY BUFA; IN THIS FFT, DIFFERENT SUBROUTINES WILL SET 
DIFFERENT TYPE (REAL OR COMPLEX) FOR ARRAY BUFA. 


COMMON / FFTCOM/IFDB, IOERR 


COMMON /FFTCOM/ HOLDS FDB ADDRESS FOR MACRO I/O (RSX11M), CHANNEL (RT11) 
(SEE COMMENTS IN FAST MACRO ROUTINE MFREAD/MFWRIT) 


COMMON /MFARG/MEXA (4) ,NDIM, ISGN, IDIR, SCAL, IBEX, 1 CEX, IPAK 
COMMON /MFVAL/DIMA(4) , TDM1, RDM1, FBLK, TBLK, RBLK, RCOR, SIZE 
COMMON /MFINT/NDMA (4) ,NTD1,NRD1,NFBK,NTBK,NRBK,NRCR,NSZE 


COMMON AREAS /MFARG/,/MFVAL/,/MFINT/ USEFUL FOR RUNNING MASS STORE FFT 
/MFARG/ HOLDS ARGUMENTS USED IN FFT CALLES, MOSTLY EXPONENTS 
HELPER ROUTINE MFPAR COMPUTES VALUES FROM /MFARG/ INTO 
/MFVAL/ (REALS AS SOME LARGE), /MFINT/ (INTEGER EQUIVALENTS IF POSS) 
OR CAN REVERSE-COMPUTE SOME /MFARG/ FROM /MFVAL/ 
SEE COMMENTS, ROUTINE MFPAR. 


COMPLEX CBUFA(1024) 
REAL BUFA(2@48) 
EQUIVALENCE (CBUFA(1) ,BUFA(1)) 


C 
C BUFA()=CBUFA() IS WORKING AREA IN CORE STORE FOR FFT AND PROGRAM 
C 
LUN=1 
C LUN IS LOGICAL UNIT FOR PDP 11 MASS STORE I/0 
C 
LP=5 
IPRINT=@ 
C LP IS PRINTER LOGICAL UNIT, IPRINT=+1 COPIOUS, @ MAX DIFFERENCES ONLY 
C 
IRMF=-1 
C IRMF=-1 REAL ROUTINE RMFFT TEST, @ COMPLEX ROUTINE CMFFT TEST 
Cc 
ISGN=-1 
IDIR=-1 
IPAK=1 
C FFT ARGS, ISGN=+/- 1, IDIR=-1 (RMFFT), IDIR=1 OR @ (CMFFT) 
C IPAK=1, @ OR -1 (RMFFT), NOT USED (CMFFT) 
C 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 


IF (IPRINT.LE.@)WRITE (LP, 910) IPRINT, IRMF 


916 FORMAT(31H1IMASS STORE FFT TEST - IPRINT =,13, 


X 25H (1=COPIOUS,@=MAX DIFFS),, 
X 9H IRMF =,13,28H (@=CMFFT TEST,1=RMFFT TEST) /) 
DIFMG=0. 


MEXA(1)=8 
MEXA (2) =6 
NDIM=2 
IBEX=7 
ICEX=11 


C MORE FFT ARGS, 2**8 ROWS OF 2**6 ELMTS, 2 DIMEN, 
C FFT MASS STORE BLOCKS 2**IBEX REALS, BUFA 2**ICEX REALS 
Cc 
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LERR=MFPAR (IRMF, @) 
IF(IERR.NE.@)GO TO 10600 


C (NOTE HELPER ROUTN MFPAR RETURNS NFBK AS MAXIMUM FILE SIZE) 
Cc 
STOP ‘ASSIGN AND OPEN FILE HERE! 
C DELETE ABOVE LINE AND INVOKE SYSTEM MACRO 'OPENS' (RSX) OR '.OPEN (RT11) 
C 
C FOR EXAMPLE, A FORTRAN CALLABLE SUBROUTINE 'MFOPEN' COULD OPEN FILE 
C '‘FFTTEST.DAT', RETURNING IFDB=FDB ADDRESS (RSX11M) IN COMMON/FFTCOM/ 
C OF CHANNEL NUMBER (RT11), FOR USE BY MACRO MFREAD/MFWRIT, THUS: 
Cc 
Cc CALL MFOPEN(LUN, 'FFTTEST.DAT' , LFDB) 
Cc 
LOERR=0@ 
C PRESET IOERR IN /FFTCOM/; ZERO IF NO ERRORS IN 1/0 
C 
NCNT=NRD1 
C HELPER ROUTINE, NCNT NUM OF ELMTS IN 'FIRST' DIMEN, NTD1 TOTAL BLOCKS 
6 
M=MFSUM(MEXA ,NDIM, 99) 
SCAL=1. 
VALU=@. 


VINC=1./SIZE 
IF(IRMF.EQ.0)GO TO 50 
SWITCH FOR COMPLEX ROUTINE CMFFT AT 5@, REAL RMFFT BELOW 


Qa 


DO 46 JB=1,NTD1 
DO 35 I=1,NCNT 
BUFA(1)=VALU . 
35 VALU=VALU+VINC 
CALL MFWRIT(BUFA,NRD1, JB) 
40 CONTINUE 
C LOAD RAMP FUNCTN IN REAL ARRAY IN ‘RECDS' OF NRD1 LENGTH 
C (NOTE, 'MACRO' MFREAD/MFWRIT CAN ACCEPT 'RECORDS' OF DIFFERENT LENGTH; 
C SO CAN USE NTD1,NRD1 HERE INSTEAD OF NTBK,NRBK AS IN FORTRAN MASS STORE) 
Cc 
CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
C REAL MASS STORE ROUTINE RMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 
GO TO 7@ 
Cc 
C BELOW, USE COMPLEX ROUTINE CMFFT, NCNT NUM OF CMPLX ELMTS IN 'FIRST' DIMEN 
50 NCNT=NCNT /2 
DO 6@ JB=1,NTD1 
DO 55 I=1,NCNT 
CBUFA(1I)=CMPLX (VALU, @. ) 
55 VALU=VALU+VINC 
CALL MFWRIT(BUFA,NRD1, JB) 
60 CONTINUE 
C LOAD RAMP FUNCTN IN COMPLEX ARRAY IN 'RECDS' OF NRD1 LENGTH 
C (NOTE, 'MACRO' MFREAD/MFWRIT CAN ACCEPT 'RECORDS' OF DIFFERENT LENGTH; 
C SO CAN USE NTD1,NRD1 HERE INSTEAD OF NTBK,NRBK AS IN FORTRAN MASS STORE) 
Cc 
CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C COMPLEX MASS STORE ROUTINE CMFFT TO TRANSFORM ARRAY TO COMPLEX RESULT 


Cc 
76 IF(IPRINT.LE.@)GO TO 75 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE (LP, 910) [PRINT , [RMF 
WRITE (LP, 920)NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
926  FORMAT(8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 10H MEXA() =,315) 
WRITE (LP, 930) 
930 FORMAT(8H INDEX,12X, 3HFFT) 


IERR=MFPAR (-IRMF, @) 
IF(IERR.NE.@)GO TO 10600 


NCNT=NRD1/2 
HELPER ROUTN, NTD1 TOTAL NUMB OF NRD1 REALS IN 'FIRST' DIMEN 


C 
C (NOTE IRMF=+1 FOR DATA IN COMPLEX STATE, NCNT ELMTS) 
C 
C 


BELOW, PROGRAM CAN ACCESS FFT COMPLEX RESULT (AND FORM COMPARISON, IF KNOWN) 
DO 8¢@ JB=1,NTD1 
K=(JB-1) *NCNT 
CALL MFREAD (BUFA,NRD1, JB) 
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C READ 'RECDS' OF NRD1 LENGTH, TOTALLING NTD1 (RECOMPUTED BY MFPAR) 

C (NOTE, 'MACRO' MFREAD/MFWRIT CAN ACCEPT 'RECORDS' OF DIFFERENT LENGTH; 

C SO CAN USE NTD1,NRD1 HERE INSTEAD OF NTBK,NRBK AS IN FORTRAN MASS STORE) 
Cc 


DO 8@ I=1,NCNT 
INDEX=J-1 
IF(IPRINT.LE.@)GO TO 8@ 
WRITE (LP, 940) INDEX, CBUFA(1) 
940  FORMAT(1X,15,2X, 2E13.4) 
89 CONTINUE 
Cc 
C BELOW, INVERT ISGN AND IDIR FOR INVERSE TRANSFORM (COMPLEX-TO-REAL) 
75 ISGN=-ISGN 
IDIR=-IDIR 
SCAL=1./SIZE 
IF (IRMF.NE.@) 
X CALL RMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA,IBEX,ICEX, IPAK) 
EITHER ROUTINE RMFFT INVERSE TRANSFORMS ARRAY TO PACKED REAL 


aa 


IF (IRMF.EQ.@) 
X CALL CMFFT (MEXA,NDIM,ISGN,IDIR,SCAL, BUFA, IBEX, ICEX) 
C OR ROUTINE CMFFT INVERSE TRANSFORMS ARRAY 
C 


IF(IPRINT.LE.@)GO TO 85 
C BELOW, PRINT HEADINGS FOR TEST OUTPUT 
WRITE (LP, 910) [PRINT , IRMF 
WRITE (LP, 92@) NDIM, ISGN, IDIR, IBEX, ICEX, IPAK, 
X  (MEXA(J),J=1,NDIM) 
WRITE (LP, 960) 
960  FORMAT(8H INDEX, 4X, 8HFFT/2**M, 6X, 5HINPUT,10X, 4HDIFF) 


85 IERR=MFPAR (IRMF, @) 

LF(IERR.NE.@)GO TO 10060 

NCNT=NRD1 

IF (IRMF.EQ.@)NCNT=NCNT/2 
C HELPER ROUTN, NTD1 TOTAL NUMB OF NRD1 REALS IN 'FIRST' DIMEN 
C  (NCNT IS NUMBER OF ELMTS IN 'FIRST' DIMEN, REAL OR CMPLX) 
C 
Cc 


BELOW, COMPARES FFT INVERSE RESULT WITH INITIAL RANDOM INPUT 
DIFM=@. 
VALU=@. 
DO 94 JB=1,NTD1 
CALL MFREAD(BUFA,NRD1, JB) 
C READ 'RECDS' OF NRD1 LENGTH, TOTALLING NTD1 (RECOMPUTED BY MFPAR) 
C (NOTE, ‘MACRO’ MFREAD/MFWRIT CAN ACCEPT 'RECORDS' OF DIFFERENT LENGTH; 
C SO CAN USE NTD1,NRD1 HERE INSTEAD OF NTBK,NRBK AS IN FORTRAN MASS STORE) 
Cc 


DO 94 I=1,NCNT 
LF (IRMF.NE.@) RM=BUFA (I) 
IF (IRMF.EQ.@)RM=REAL (CBUFA (I) ) 
DIF=ABS (RM-VALU) 
LF (DLF.GT.DIFM)DIFM=DIF 
IF(IPRINT.GT.@)WRITE (LP, 990) 1,RM, VALU,DIF 
99%  FORMAT(1X,1I5,3(2X,E13.4)) 
VALU=VALU+VINC 
90 CONTINUE 
C PRINT INVERSE RESULTS (SHOULD BE SAME AS INITIAL RAMP) 
Cc 
IF (IPRINT.GE.@) WRITE (LP, 950) DIFM,NDIM, ISGN, IDIR, [BEX, ICEX, IPAK, 
X (MEXA(J),J=1,NDIM) 
95@  FORMAT(1@H MAX DIFF ,E11.4,1X, 
X 8H NDIM =,13,8H ISGN =,13,8H IDIR =,13, 
X 8H IBEX =,13,8H ICEX =,13,8H IPAK =,13, 
X 1@H MEXA() =,315) 
IF (DIFM.GT.DIFMG) DIFMG=DIFM 
C 
STOP 
C 
1006 WRITE(LP,9806) TERR 
986 FORMAT(25H IBEX FORCED TOO SMALL OR, 
X  3@H NOT ALL /MFINT/ CORRECT, IERR,I4) 
STOP 
END 
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PDP11 RSX11M OR RT11 FAST MACRO I/O: ROUTINES FOR FFT 


SUBROUTINE MFREAD(BUFA, NB, JB) 
SUBROUTINE MFWRIT(BUFA, NB, JB) 


we we we we we we 


3C READ BLOCK, INDEX JB, FROM MASS STORE TO BUFA, NB REAL VALUES 
3C WRITE BLOCK, INDEX JB, FROM BUFA TO MASS STORE, NB REAL VALUES 
3 

: COMMON/FFTCOM/IFDB,IOERR (RSX11 FDB ADDRESS, ERROR) 

3OR COMMON/FFICOM/ICHAN,IOERR (RT11 CHANNEL NUM, ERROR) 


;NOTE1: FILE MUST BE PROPERLY OPEN FOR READ/WRITE ACCESS AND WITH 
; RSX11M FDB ADDRESS OR RT11 CHANNEL NUMBER IN FIRST WORD 

; OF COMMON/FFTCOM/ (IE. INVOKE RSX11M OR RT11 OPEN MACROS). 
> 


;NOTE2: I/O ERRORS, IF THEY OCCUR, ARE RETURNED IN SECOND WORD 

H OF COMMON/FFTCOM/. THIS WORD (IOERR) REMAINS UNCHANGED 

. IF NO ERROR OCCURS - THUS, IF PRESET TO @ BEFORE CALLING 

;: MFREAD/MFWRIT (OR MASS STORE FFT), WILL FINALLY BE 

: @ IF NO ERRORS, OR NON ZERO=LAST ERROR (SEE FOLLOWING LABEL L4:). 


;NOTE3: NB MUST BE AN INTEGRAL POWER OF 2; 128 OR MORE MOST EFFICIENT 
H (NB.LE.64 USES LOCAL 256 WORD JBUF TO HOLD SECTOR; 
3 WRITE ALWAYS WRITES THIS SECTOR TO FILE; SLOW BUT SAFE). 


3 
;NOTE4: READY TO ASSEMBLE FOR RSX11M. FOR RT11, ERASE FOLLOWING LINE: 
RSX=0@ 


.IF DF, RSX 

; CONDITIONAL SECTION FOR RSX11M (V3) 
-TITLE MFREAD(RSX11M) 
-MCALL READS,WRITES,WAITS . 
-PSECT FFTCOM,RW,D,GBL,REL,OVR 


IFDB: .WORD @ ;FDB ADDRESS 

IOERR: .WORD @ ;ERROR FLAG (UNCHANGED IF NO ERROR) 
.PSECT 
.ENDC 

; 
.IF NDF, RSX 


; CONDITIONAL SECTION FOR RT11 (V3) 
-TITLE MFREAD(RT11) 
-MCALL .READW, .WRITW 


ERRBYT=52 
.PSECT FFTCOM,RW,D,GBL,REL,OVR 

ICHAN: .WORD @ ;CHANNEL NUMBER 

IOERR: .WORD @ ;ERROR FLAG (UNCHANGED IF NO ERROR) 
.PSECT MFREAD,RW,I,LCL,REL,OVR 
.ENDC 


-GLOBL MFREAD,MFWRIT 


MFREAD: MOV #1,R0 ;MFREAD SETS JSW=1 


BR Ll 
MFWRIT: MOV #+-1,R@ ;MFWRIT SETS JSW=-1 
Ll: MOV RO, JSW s;HOLD JSW 
TST (R5)+ ;IGNORE ARGUMENT COUNT 
MOV (R5)+,R3 ;R3=ADDRESS OF 'BUFA' 
MOV @(R5)+,R2 3;R2='"NB' 
MOV @(R5)+,R1 ;R1='JB' 
; FINISH ACCESSING SUBROUTINE ARGUMENTS 
> 
DEC RL ;R1=JB-1 
ASL R2 3;R2=WORD COUNT, NB*2 
MOV R2,R5 3;COPY TO R5 
BEQ L6 ;FINISH IF COUNT ZERO 
CLR RO ;CLEAR R@ FOR WORD OFFSET 
CMP R5,#256. 3;CHECK WHETHER WHOLE SECTORS 
BLT E12 3;GO TO L12 IF NOT (MORE COMPLEX) 
; BELOW, SCALE Rl TO SECTOR OFFSET (ASSUMES NWD POWER OF 2) 
L1¢: BIT #256. ,R5 3;LOOK FOR BIT AT 256. 
BNE Tt: 3;RL COMPLETE WHEN FOUND 


ASL R1 3SCALE R1 ACCORDING TO R5 
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ASR R5 
BR L1¢ 
> 
; NOW HAVE R1=SECTOR START (FIRST=0@) 
; R2=WORD COUNT 
: R3=BUFA ADDRESS 
’ 
Lil: MOV JSW,JSWIO ;SET UP FOR READ/WRITE 
BGT L13 
MOV #+1,SECHLD sDIRECT WRITE, ENSURE JBUF LOOKS EMPTY 
L13: JSR PC, INOUT 3;CALL DIRECT INPUT/CUTPUT 
L6: RTS PC s;RETURN FROM SUBROUTINE 
; END OF SIMPLE DIRECT INPUT/OUTPUT 
b) 
.IF DF,RSX 
; CONDITIONAL SECTION FOR RSX11M 
INOUT: ASL R2 ;RSX11M NEEDS BYTE COUNT=NB¥*4 
INC RL 3;RSX11M SECTOR STARTS WITH 1 
MOV R1,SECTL ;HOLD AS LOWER SECTOR VALUE 
MOV IFDB,R4 3;R4=FDB ADDRESS 
MOVB F.LUN(R4),R1 3USE LUN FOR EVENT FLAG 
> 
TST JSWLO 
BLT L5 ;BRANCH IF WRITE 
MOV F.EFBK+2(R4),R@ ;GET LOW SECTOR OF EOF 
DEC RG ;ALLOW FOR HEADER SECTOR 
CMP R@,SECTL ;TEST IF SECTOR EXISTS YET 
BLT Ly 3;NO READ IF DOES NOT EXIST 


READS R4,R3,R2,#SECT,R1 ;FDB,BUF,BYTCNT,SECT,EVFLG 


L4: MOV IFDB,R4 3;R4=FDB ADDRESS 
MOVB F.LUN(R4) ,R1 3USE LUN FOR EVENT FLAG 
WAITS R4,R1 ;WAIT FOR I/O FINISH 
BCC 7 ;NO ERROR IF CARRY CLEAR 
MOV IFDB,R4 3;R4=FDB ADDRESS 
MOVB F.ERR(R4) ,R4 s;HOLD NEGATIVE ERROR CODE 
MOV R4, IOERR ;IN IOERR IN COMMON/FFTCOM/ 
107 RTS PC 
L5: WRITE$ R4,R3,R2,#SECT,R1 ;FDB,BUF,BYTCNT,SECT,EVFLG 
BR L4 
3 
SECT: -WORD @ ;HOLDS SECTOR VALUE (HIGHER, ALWAYS 0) 
SECTL: .WORD @ ; (LOWER, COMPUTED) 
. ENDC 
.IF NDF ,RSX 
;CONDITIONAL SECTION FOR RT11 
INOUT: MOV ILCHAN ,R4 ;R4=CHANNEL NUMBER 
TST JSWIO 
BLT LS ;BRANCH IF WRITE 
-READW #AREA,R4,R3,R2,R1 ;AREA, CHAN , BUF ,WDCNT , SECT 
L4: BCC L7 3;NO ERROR IF CARRY CILEAR 
; 
MOVB ERRBYT,R4 ;HOLD ERROR CODE + 1 (TO MAKE NON ZERO) 
INC R4 sERRORS $,1,2 GO TO 1,2,3 
MOV R4, LOERR ;IN IOERR IN COMMON/}FTCOM/ 
iy sh RTS PC 
; 
LS: -WRITW #AREA,R4,R3,R2,R1 ; AREA, CHAN, BUF, WDCNT , SECT 
BR L4 
AREA: -BLKW 10 3;AREA FOR RT11 1/0 MACROS USE 
. ENDC 


3; BELOW, MORE COMPLEX HANDLING OF NWD.LT.256 (PART SECTORS) 
L12: CLC 


ROR Rl 3;SCALE R1/R@ RIGHT ACCORDING TO R5 
ROR R@ 3R@ HOLDS FLOW OUT OF R1 
ASL R5 


BIT #256. ,R5 3LOOK FOR BIT 256 
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BNE 
BR 
3 
L2¢: SWAB 
ASL 
NOW HAVE 


we we we we we we we 
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L2@ 
L12 


RO 
RO 


3R1/R@ COMPLETE IF FOUND 


R@=BYTE OFFSET IN LOCAL BUFFER 
R1=SECTOR REQUIRED 


R2=WORD COUNT 


R3=USER BUFA ADDRESS 


ADD #IBUF ,RO 
CMP SECHLD, R1 
BNE L24 
L21: ‘TST JSW 
BLT L23 
; BELOW, 'READ' PART SECTOR 
L22: MOV (RO)+, (R3)+ 
DEC R2 
BGT L22 
JMP L6 


3; BELOW, 'WRITE' PART SECTOR 


L23: MOV 
DEC 
BGT 
MOV 
JSR 
JMP 


. 
> 


(R3)+, (RO)+ 
R2 

L23 

#+1, ISWIO 
PC, LINOUT 
L6 


BELOW, TRANSFER BETWEEN LOCAL AND USER BUFFER 


;R@=JBUF ADDRESS + OFFSET 

;CHECK CURRENT SECTOR LOADED 
sMUST FIRST LOAD SECTO AT L24 IF NEC 
3;TEST WHETHER READ/WRITE 


;COPY LOCAL TO USER BUFA 


' 3FINISH 


;COPY USER TO LOCAL BUF 


3SET UP I/O FOR WRITE 
;WRITE FROM LOCAL JBUF (SLOW BUT SAFE) 
; FINISH 


; BELOW, LOAD LOCAL JBUF, IF POSSIBLE 


L24: MOV 


R1,SECHLD 
#1, ISWLO 
PC, LINOUT 
L21 


;HOLD CURRENT SECTOR NUM 
3SET UP FOR READ 
3DO LOCAL READ TO JBUF 


; BELOW, LOCAL INPUT/OUTPUT ROUTINE 


LINOUT: MOV 
MOV 
MOV 
MOV 
MOV 
MOV 
JSR 
MOV 
MOV 
MOV 
MOV 
RTS 


. 
> 


RO, -(SP) 
R1,-(SP) 
R2,-(SP) 
R3,-(SP) 
#256. ,R2 
#JIBUF,R3 
PC, INOUT 
(SP)+,R3 
(SP)+,R2 
(SP)+,R1 
(SP)+,RO 
PC 


3; BELOW, LOCAL VARIABLES 


JSW: WORD 
JSWIO: .WORD 
SECHLD: .WORD 
JBUF: - BLKW 


- END 


;SAVE REGISTERS R@ TO R3 


3R2=256. FOR WHOLE SECTOR 
3R3 IS LOCAL JBUF ADDRESS 
3;CALL INOUT ROUTINE 
s;RESTORE REGISTERS R@ TO R3 


3;JSW=+1 MFREAD, -1 MFWRIT 


¢ sACTUAL JSW USED FOR INOUT ROUTINE 
-1 s;CURRENT SECTOR LOADED IN JBUF 
256. 3;JBUF 256 WORD LOCAL BUFFER FOR NWD.LT.256 
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ALGORITHM 546 
SOLVEBLOK [F4] 


CARL DE BOOR 

Mathematics Research Center, The University of Wisconsin—Madison 
and 

RICHARD WEISS 

Technische Universitat Wien, Austria 


Key Words and Phrases: almost block diagonal systems, Gaussian elimination, spline 
approximation, ordinary differential equations 

CR Categories: 5.13, 5.14, 5.17 

Language: Fortran 


DESCRIPTION 


This Fortran package is a complement to [1] where its design is explained and it 
is compared with related algorithms. 


REFERENCES 


1. DE Boor, C., AND WEIss, R. SOLVEBLOK: A package for solving almost block diagonal linear 
systems. ACM Trans. Math. Software 6, 1 (March 1980), 80-87. 


ALGORITHM 

SUBROUTINE SLVBLK ( BLOKS, INTEGS, NBLOKS, B, IPIVOT, X, IFLAG ) BLK@01060 
C THIS PROGRAM SOLVES THE LINEAR SYSTEM A*X = B WHERE A IS AN BLKGOO200 
C ALMOST BLOCK DIAGONAL MATRIX. SUCH ALMOST BLOCK DIAGONAL MATRICES  BLKOO300 
C ARISE NATURALLY IN PIECEWISE POLYNOMIAL INTERPOLATION OR APPROX-— BLKOO406 
C IMATION AND IN FINITE ELEMENT METHODS FOR TWO-POINT BOUNDARY VALUE BLK@(500 
C PROBLEMS. THE PLU FACTORIZATION METHOD IS IMPLEMENTED HERE TO TAKE BLKQG600 
C ADVANTAGE OF THE SPECIAL STRUCTURE OF SUCH SYSTEMS FOR SAVINGS IN BLKOGO700 
C COMPUTING TIME AND STORAGE REQUIREMENTS. BLKOO8OO 
Cc BLKOOGIGO 
Cc PARAMETERS BLKO10060 
C BLOKS' A ONE-DIMENSIONAL ARRAY, OF LENGTH BLKO1100 
Cc SUM( INTEGS (1,1)*INTEGS(2,1) , I = 1,NBLOKS ) BLKQ12060 
C ON INPUT, CONTAINS THE BLOCKS OF THE ALMOST BLOCK DIAGONAL  BLK@136@ 
C MATRIX A THE ARRAY INTEGS (SEE BELOW AND THE EXAMPLE)  BLK@146¢ 
Cc DESCRIBES THE BLOCK STRUCTURE. BLKO1500 
Cc ON OUTPUT, CONTAINS CORRESPONDINGLY THE PLU FACTORIZATION BLKO1600 
Cc OF A (IF IFLAG .NE. @). CERTAIN OF THE ENTRIES INTO BLOKS BLKQ1700 
Cc ARE ARBITRARY (WHERE THE BLOCKS OVERLAP). BLKO1800 
C INTEGS INTEGER ARRAY DESCRIPTION OF THE BLOCK STRUCTURE OF A. BLKO1900 
C INTEGS(1,1) = NO. OF ROWS OF BLOCK I = NROW BLKO20600 
C INTEGS (2,1)= NO. OF COLUMNS OF BLOCK I = NCOL BLKO21060 
Cc INTEGS(3,1) = NO. OF ELIM. STEPS IN BLOCK I = LAST BLKO2200 
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ATAAGAANAIAIAARRAAAAAARAAANDAAARANRNNANAANANQAANANKNAAANANAKNANANMNANAAANNAAMAAAANAKMANAAMAAMAAMAANNAANANAANAAAANAANA 


I = 1,2,...,NBLOKS 
THE LINEAR SYSTEM IS OF ORDER 
N = SUM ( INTEGS(3,I) , I=1 
BUT THE TOTAL NUMBER OF ROWS IN THE 
NBROWS = SUM( INTEGS(1,I) , I = 
NBLOKS NUMBER OF BLOCKS 
B RIGHT SIDE OF THE LINEAR SYSTEM, ARRAY OF LENGTH NBROWS. 
CERTAIN OF THE ENTRIES ARE ARBITRARY, CORRESPONDING TO 
ROWS OF THE BLOCKS WHICH OVERLAP (SEE BLOCK STRUCTURE AND 
THE EXAMPLE BELOW). 
ON OUTPUT, INTEGER ARRAY CONTAINING THE PVOTING SEQUENCE 
USED. LENGTH IS NBROWS 
X ON OUTPUT, CONTAINS THE COMPUTED SOLUTION (IF IFLAG .NE. 6) 
LENGTH IS N. 
ON OUTPUT, INTEGER 
= (-1)**(NO. OF INTERCHANGES DURING FACTORIZATION) 
IF A IS INVERTIBLE 
IF A IS SINGULAR 


=1,...,NBLOKS ), 
BLOCKS IS 
1,...,NBLOKS) 


IPIVOT 


IFLAG 


= @ 


AUXILIARY PROGRAMS 
FCBLOK (BLOKS,INTEGS ,NBLOKS,IPIVOT,SCRTCH,IFLAG) FACTORS THE MATRIX 
A , AND IS USED FOR THIS PURPOSE IN SLVBLK. ITS ARGUMENTS 
ARE AS IN SLVBLK, EXCEPT FOR 
SCRICH = A WORK ARRAY OF LENGTH MAX(INTEGS(1,1)). 


SBBLOK (BLOKS,INTEGS,NBLOKS,IPIVOT,B,X) SOLVES THE SYSTEM A*X = B 
ONCE A IS FACTORED. THIS IS DONE AUTOMATICALLY BY SLVBLK 
FOR ONE RIGHT SIDE B, BUT SUBSEQUENT SOLUTIONS MAY BE 
OBTAINED FOR ADDITIONAL B-VECTORS. THE ARGUMENTS ARE ALL 
AS IN SLVBLK. 


DIBLOK (BLOKS, INTEGS ,NBLOKS , IPIVOT,IFLAG,DETSGN,DETLOG) COMPUTES THE 
DETERMINANT OF A ONCE SLVBLK OR FCBLOK HAS DONE THE FACT-— 


ORIZATION.THE FIRST FIVE ARGUMENTS ARE AS IN SLVBLK. 
DETSGN = SIGN OF THE DETERMINANT 
DETLOG = NATURAL LOG OF THE DETERMINANT 


BLOCK STRUCTURE OF A 
THE NBLOKS BLOCKS ARE STORED CONSECUTIVELY IN THE ARRAY BLOKS 
THE FIRST BLOCK HAS ITS (1,1)-ENTRY AT BLOKS(1), AND, IF THE I-TH 
BLOCK HAS ITS (1,1)-ENTRY AT BLOKS(INDEX(I)), THEM 

INDEX({IT+1) = INDEX(I + WNROW(I)*NCOL(Z) 

THE BLOCKS ARE PIECED TOGETHER TO GIVE THE INTERESTING PART OF A 
AS FOLLOWS. FOR I = 1,2,...,NBLOKS-1, THE (1,1)-ENTRY OF THE NEXT 
BLOCK (THE (I+1)ST BLOCK ) CORRESPONDS TO THE (LAST+1,LAST+1)-ENTRY 
OF THE CURRENT I-TH BLOCK. RECALL LAST = INTEGS(3,1) AND NOTE THAT 
THIS MEANS THAT 

A. EVERY BLOCK STARTS ON THE DIAGONAL OF A. 

B. THE BLOCKS OVERLAP (USUALLY). THE ROWS OF THE (I+1)ST BLOCK 
WHICH ARE OVERLAPPED BY THE I-TH BLOCK MAY BE ARBITRARILY DE- 
FINED INITIALLY. THEY ARE OVERWRITTEN DURING ELIMINATION. 

THE RIGHT SIDE FOR THE EQUATIONS IN THE I-TH BLOCK ARE STORED COR- 
RESPONDINGLY AS THE LAST ENTRIES OF A PIECE OF B OF LENGTH NROW 
(= INTEGS(1,1)) AND FOLLOWING IMMEDIATELY IN B THE CORRESPONDING 
PIECE FOR THE RIGHT SIDE OF THE PRECEDING BLOCK, WITH THE RIGHT SIDE 
FOR THE FIRST BLOCK STARTING AT B(1) . IN THIS, THE RIGHT SIDE FOR 
AN EQUATION NEED ONLY BE SPECIFIED| ONCE ON INPUT, IN THE FIRST BLOCK 
IN WHICH THE EQUATION APPEARS. 


EXAMPLE AND TEST DRIVER 
THE TEST DRIVER FOR THIS PACKAGE CONTAINS AN EXAMPLE, A LINEAR 
SYSTEM OF ORDER 11, WHOSE NONZERO ENTRIES ARE INDICATED IN THE FOL- 

LOWING SCHEMA BY THEIR ROW AND COLUMN INDEX MODULO 1@. NEXT TO IT 


ARE THE CONTENTS OF THE INTEGS ARRRAY WHEN THE MATRIX IS TAKEN TO 
BE ALMOST BLOCK DIAGONAL WITH NBLOKS = 5, AND BELOW IT ARE THE FIVE 
BLOCKS. 
NROW1 = 3, NCOL1 = 4 
11 12 13 14 
21 22 23 24 WNROW2 = 3, NCOL2 = 3 
31 32 33 34 
LAST1 = 2 43 44 45 
53 54 55 NROW3 = 3, NCOL3 = 4 
LAST2 = 3 66 67 68 69 NROW4 = 3, NCOL4 = 4 
76 77 78 79 NROWS = 4, NCOLS = 4 
86 87 88 89 
LAST3 = 1 97 98 99 96 


BLKO2 3060 
BLKO2400 
BLKO2500 
BLKO2600 
BLKO2760 
BLKQ2800 
BLKO2900 
BLKO3000 
BLKO3100 
BLKO3200 
BLKO3300 
BLKO3400 
BLKO3500 
BLKG3600 
BLKO3700 
BLKO3800 
BLKO3900 
BLKO4000 
BLKO4100 
BLKO4200 
BLKO4 300 
BLKG44060 
BLKO4500 
BLKO4660 
BLKO4700 
BLKO4800 
BLKG4960 
BLKO5000 
BLKO51060 
BLKO5200 
BLKO5 300 
BLKO5460 
BLKO5500 
BLKO5600 
BLKO5760 
BLKO5800 
BLKG5900 
BLKG6000 
BLKG610@ 
BLKO6 200 
BLKG6300 
BLKO6460 
BLKO6500 
BLKG6600 
BLKG6700 
BLKG6800 
BLKO6900 
BLKO7000 
BLKO7100 
BLKG7200 
BLKQO7 300 
BLKO7400 
BLKO7500@ 
BLKO7600 
BLKQ7 70@ 
BLKO78006 
BLKO7900 
BLKO8O00 
BLKO8100 
BLKG8200 
BLKO8300 
BLKO8460 
BLKO8500@ 
BLKO8600 
BLKO8700 
BLKG880¢ 
BLKO8960 
BLKG9IGOO 
BLKO9I100 
BLKO9 200 
BLKO9300 
BLKO9 400 
BLKO9500@ 
BLKO9606 
BLKO9 700 
BLKO9 800 
BLKO99G0O 
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QAQAQAAAAARAARAAANRAAANANANANAANAANAN 


Cc 
C 


C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
Cc 
C 
C 
C 
C 
C 
Cc 
C 
C 
C 
C 
C 


1¢ 


LAST4 = 1 


LAST5 = 4 


08 09 OO G1 
18 19 16 11 


ACTUAL INPUT TO BLOKS SHOWN BY ROWS OF BLOCKS OF A . 
(THE ** ITEMS ARE ARBITRARY, THIS STORAGE IS USED BY SLVBLK) 


1112 13 14 / #* #k xX 
21 22 23 24 / 43 44 45 / 


31 32 33 34/ 


INDEX = 1 


53 54 


INDEX 


55/ 


13. INDEX = 22 


/ 66 67 68 69 / k RK KK KK 
76 77 78 79 / 
86 87 88 89/ 


kk ORK 
97 98 9 


INDEX = 


/ kK KK KK RK 


kkk [RR RR kK wk 
9 99/ 68 69 6 G1 
18 19 16 11 

34 INDEX = 46 


ACTUAL RIGHT SIDE VALUES WITH ** FOR ARBITRARY VALUES 


Bl B2 B3 ** B4 B5 B6 B7 B8 ** ** BO ** Kk BIG BIL 


(IT WOULD HAVE BEEN MORE EFFICIENT TO COMBINE BLOCK 3 WITH BLOCK 4) 


INTEGER INTEGS(3,NBLOKS) , IPIVOT(1) , LFLAG 
REAL BLOKS(1) ,B(1),X(1) 


IN THE CALL TO FCBLOK, 


X IS USED FOR TEMPORARY STORAGE. 


CALL FCBLOK(BLOKS , INTEGS , NBLOKS , [LPLVOT ,X, IFLAG) 
IF (IFLAG .EQ. @) 
CALL SBBLOK(BLOKS , INTEGS ,NBLOKS , LPIVOT,B,X) 
RETURN 


END 


RETURN 


BLK100600 
BLK16100@ 
BLK16260 
BLK10300 
BLK10400 
BLK16500 
BLK19660 
BLK1076@ 
BLK16800 
BLK16900 
BLK1160@ 
BLK11100 
BLK1120@ 
BLK1130@ 
BLK114060 
BLK1150@ 
BLK11600 
BLK1174@ 
BLK1180@ 
BLK11900 
BLK120600 
BLK12160 
BLK12200@ 
BLK12300 
BLK12400 
BLK12560 
BLK1260@ 


SUBROUTINE FCBLOK ( BLOKS, INTEGS, NBLOKS, IPIVOT, SCRTCH, IFLAG )BLK1270@ 
CALLS SUBROUTINES FACTRB AND SHIFTB. 


FC BLOK_ SUPERVISES THE PLU FACTORIZATION WITH PIVOTING OF 


FACTRB = 


SHIFTB = 


PARAMETERS 


BLOKS 


INTEGS 
NBLOKS 
IPIVOT 
SCRTCH 


IFLAG 


INTEGS. 


SUBPROGRAM WHICH CARRIES OUT STEPS 1,.. 
ELIMINATION (WITH PIVOTING) FOR AN INDIVIDUAL BLOCK. 

SUBPROGRAM WHICH SHIFTS THE REMAINING ROWS TO THE TOP OF 
THE NEXT BLOCK 


SCALED ROWS OF THE ALMOST BLOCK DIAGONAL MATRIX STORED IN THE ARRAYS 
BLOKS_ AND 


- LAST OF GAUSS 


AN ARRAY THAT INITIALLY CONTAINS THE ALMOST BLOCK DIAGONAL 
MATRIX A TO BE FACTORED, AND ON RETURN CONTAINS THE COM- 
PUTED FACTORIZATION OF A. 
AN INTEGER ARRAY DESCRIBING THE BLOCK STRUCTURE OF A. 
THE NUMBER OF BLOCKS IN A 


AN INTEGER ARRAY OF DIMENSION SUM (INTEGS(1,1) 


» i=l, 


...,NBLOKS) WHICH, ON RETURN, CONTAINS THE PIVOTING STRA- 
TEGY USED. 
WORK AREA REQUIRED, OF LENGTH MAX (INTEGS(1,I) , I=1, 
...,NBLOKS). 

OUTPUT PARAMETER, 
= @ IN CASE MATRIX WAS FOUND TO BE SINGULAR. 
OTHERWISE, 
= (-1)**(NUMBER OF ROW INTERCHANGES DURING FACTORIZATION) 


INTEGER INTEGS(3,NBLOKS) , IPIVOT(1),IFLAG, 1, INDEX, INDEXB, INDEXN, 
LAST ,NCOL, NROW 
REAL BLOKS (1) ,SCRTCH(1) 


* 


IFLAG = 
INDEXB 
INDEXN 
IT=1 


NROW 
NCOL 
LAST 


1 


1 
1 


INDEX = INDEXN 


LOOP OVER THE BLOCKS. 


INTEGS (1,1) 
INTEGS (2,1) 
INTEGS (3,1) 
CARRY OUT ELIMINATION ON THE I-TH BLOCK UNTIL NEXT BLOCK 
ENTERS, I.E., FOR COLUMNS 1,...,LAST OF I-TH BLOCK. 

CALL FACTRB(BLOKS (INDEX) , IPIVOT (INDEXB) , SCRTCH,NROW,NCOL,LAST, 


IFLAG) 


I IS LOOP INDEX 


CHECK FOR HAVING REACHED A SINGULAR BLOCK OR THE LAST BLOCK 


IF (IFLAG .EQ. @ .OR. I .EQ. NBLOKS) 
RETURN 


BLK128@ 
BLK12966 
BLK1306¢@ 
BLK13160 
BLK13200 
BLK13300 
BLK13400 
BLK13500 
BLK13600 
BLK13700 
BLK13860 
BLK13900 
BLK14060 
BLK14100 
BLK14260 
BLK14300 
BLK144066 
BLK14500 
BLK14600 
BLK1470@ 
BLK1480@ 
BLK1490@ 
BLK15000@ 
BLK1516@ 
BLK1520¢ 
BLK15 300 
BLK15460 
BLK1550@ 
BLK1560@ 
BLK1570@ 
BLK1580¢ 
BLK1590@ 
BLK16000 
BLK1610606 
BLK16200 
BLK16 300 
BLK1646@ 
BLK1650@ 
BLK16600 
BLK16700 
BLK16800 
BLK16900 
BLK170600 
BLK1716¢ 
BLK17200 
BLK17300 
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| ee ee BLK174060 

INDEXN = NROW*NCOL + INDEX BLK17506 

Cc PUT THE REST OF THE I-TH BLOCK ONTO THE NEXT BLOCK BLK17600 
CALL SHIFTB(BLOKS (INDEX) , LPIVOT (INDEXB) , NROW,NCOL, LAST, BLK17700 

* BLOKS (INDEXN) , INTEGS (1,1) , INTEGS (2,1) ) BLK17800 
INDEXB = INDEXB + NROW BLK1790@ 

GO TO 10 BLK180060 

END BLK18160 
SUBROUTINE FACTRB ( W, IPLVOT, D, NROW, NCOL, LAST, IFLAG ) BLK1820@ 

C ADAPTED FROM P.132 OF *ELEMENTARY NUMER.ANALYSIS* BY CONTE-DE BOOR BLK183¢¢ 
Cc BLK1846@ 
C CONSTRUCTS A PARTIAL PLU FACTORIZATION, CORRESPONDING TO STEPS 1,...,BLK1850¢ 
C LAST _ IN GAUSS ELIMINATION, FOR THE MATRIX W OF ORDER BLK186060 
C (NROW, NCOL ), USING PIVOTING OF SCALED ROWS. BLK1870@ 
Cc BLK1880@ 
C PARAMETERS BLK189¢¢ 
6 W CONTAINS THE (NROW,NCOL) MATRIX TO BE PARTIALLY FACTORED BLK190600 
c ON INPUT, AND THE PARTIAL FACTORIZATION ON OUTPUT. BLK1916@ 
Cc IPIVOT AN INTEGER ARRAY OF LENGTH NROW CONTAINING A RECORD OF THE BLK1926@ 
Cc PIVOTING STRATEGY USED. ROW IPIVOT(I) IS USED DURING THE BLK193@0 
Cc I-TH ELIMINATION STEP, I=1,...,LAST. BLK194060 
Cc D A WORK ARRAY OF LENGTH NROW USED TO STORE ROW SIZES BLK19500 
Cc TEMPORARILY. BLK19600 
C NROW NUMBER OF ROWS OF W. BLK19700 
Cc NCOL NUMBER OF COLUMNS OF W. BLK198006 
Cc LAST NUMBER OF ELIMINATION STEPS TO BE CARRIED OUT. BLK1990@ 
Cc IFLAG ON OUTPUT, EQUALS IFLAG ON INPUT TIMES (-1)**(NUMBER OF BLK2G000 
Cc ROW INTERCHANGES DURING THE FACTORIZATION PROCESS), IN BLK26100 
C CASE NO ZERO PIVOT WAS ENCOUNTERED. BLK20200 
Cc OTHERWISE, IFLAG = @ ON OUTPUT. BLK20300 
C BLK20640@ 
INTEGER IPIVOT(NROW) ,NCOL,LAST,IFLAG, I,IPIVI,IPIVK,J,K,KP1 BLK20500 

REAL W(NROW,NCOL) ,D(NROW), AWIKDI,COLMAX, RATIO, ROWMAX BLK29600 

C INITIALIZE IPIVOT, D BLK20700 
DO 1@ I=1,NROW BLK20800@ 
IPIVOT(IL) = I BLK20960 

ROWMAX = @. BLK210600 

DO 9 J=1,NCOL BLK2110@ 

9 ROWMAX = AMAX1(ROWMAX, ABS(W(I,J))) BLK21200 

IF (ROWMAX .EQ. @.) GO TO 999 BLK21360 

10 D(I) = ROWMAX BLK2146@ 

C GAUSS ELIMINATION WITH PIVOTING OF SCALED ROWS, LOOP OVER K=1,.,LAST BLK215¢¢ 
K=1 BLK21606@ 

Cc AS PIVOT ROW FOR K-TH STEP, PICK AMONG THE ROWS NOT YET USED, BLK21706¢ 
C I.E., FROM ROWS IPIVOT(K),...,IPIVOT(NROW), THE ONE WHOSE K-TH BLK2180¢ 
Cc ENTRY (COMPARED TO THE ROW SIZE) IS LARGEST. THEN, IF THIS ROW BLK2190@ 
Cc DOES NOT TURN OUT TO BE ROW IPIVOT(K), REDEFINE IPIVOT(K) AP-— BLK2200¢ 
Cc PROPRIATELY AND RECORD THIS INTERCHANGE BY CHANGING THE SIGN  BLK22160¢ 
Cc OF ITLFLAG. BLK2220¢ 
11 IPIVK = IPIVOT(K) BLK22300 

IF (K .EQ. NROW) GO TO 21 BLK224060 

J=XK BLK225@@¢ 

KP1 = K+l BLK22600 

COLMAX = ABS (W(IPIVK,K) )/D(IPIVK) BLK2270@ 

Cc FIND THE (RELATIVELY) LARGEST PIVOT BLK228060 
DO 15 I=KP1,NROW BLK22900 

IPIVI = IPIVOT(I) BLK2 3000 

AWIKDI = ABS(W(IPIVI,K))/D(IPIVI) BLK2310@ 

IF (AWIKDI .LE. COLMAX) GO TO 15 BLK232060 

COLMAX = AWIKDI BLK23300 

Je=lI BLK2 3400 

15 CONTINUE BLK235@0@ 

IF (J .EQ. K) GO TO 16 ‘BLK2 3600 

IPIVK = IPIVOT(J) BLK23700 
IPIVOT(J) = IPIVOT(K) BLK2 3860 
IPIVOT(K) = IPIVK BLK2 3900 

IFLAG = -IFLAG BLK240060 

16 CONTINUE BLK24160 

Cc IF PIVOT ELEMENT IS TOO SMALL IN ABSOLUTE VALUE, DECLARE BLK2420@ 
Cc MATRIX TO BE NONINVERTIBLE AND QUIT. BLK24 300 
IF (ABS(W(IPIVK,K))+D(IPIVK) .LE. D(IPIVK)) BLK2446@ 

* GO TO 999 BLK24560 

C OTHERWISE, SUBTRACT THE APPROPRIATE MULTIPLE OF THE PIVOT BLK24660 
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C 
C 
Cc 


aa 


AATQARANAANAARAAANRANAAANAANRNNAaAaANANRAANAAANANAA 


ROW FROM REMAINING ROWS, I.E., THE ROWS IPIVOT(K+1),..., 
IPIVOT(NROW), TO MAKE K-TH ENTRY ZERO. SAVE THE MULTIPLIER IN 


ITS PLACE. 
DO 2¢@ I=KP1,NROW 
IPIVI = IPIVOT(I) 


W(IPIVI,K) = W(IPIVI,K) /W(IPIVK,K) 
RATIO = -W(IPIVI,K) 
DO 20 J=KP1,NCOL 


20 W(IPIVI,J) = RATIO*W(IPIVK,J) + W(IPIVI,J) 
K = KPl 
CHECK FOR HAVING REACHED THE NEXT BLOCK. 
IF (K .LE. LAST) GO TO 11 
RETURN 
IF LAST .EQ. NROW , CHECK NOW THAT PIVOT ELEMENT IN LAST ROW 
IS NONZERO, 
21 IF( ABS(W(IPLVK,NROW))+D(IPIVK) .GT. D(IPIVK) ) 
* RETURN 


SINGULARITY FLAG SET 
999 IFLAG = @ 
RETURN 
END 


SUBROUTINE SHIFTB ( AI, IPIVOT, NROWI, NCOLI, LAST, 

* AI1, NROWI1, NCOLI1 ) 
SHIFTS THE ROWS IN CURRENT BLOCK, AI, NOT USED AS PIVOT ROWS, IF 
ANY, I.E., ROWS IPIVOT(LAST+1),...,IPIVOT(NROWI), ONTO THE FIRST 
MMAX = NROW-LAST ROWS OF THE NEXT BLOCK, AI1, WITH COLUMN LAST+J OF 
AI GOING TO COLUMN J , J=1,...,JMAX=NCOLI-LAST. THE REMAINING COL- 
UMNS OF THESE ROWS OF AI1 ARE ZEROED OUT. 


PICTURE 


ORIGINAL SITUATION AFTER 
LAST = 2 COLUMNS HAVE BEEN 
DONE IN FACTRB (ASSUMING NO 
INTERCHANGES OF ROWS) 


RESULTS IN A NEW BLOCK I+1 
CREATED AND READY TO BE 
FACTORED BY NEXT FACTRB CALL. 


1 
X X1X XK X X X X XK X 
1 
@ X1X X X @ X X X X 
BLOCK I ee a a a a a 
NROWI = 4 @ @1X X X @ @1X xX X @ @1 
NCOLI = 5 1 1 1 
LAST = 2 @6 @1X X X @ @1X xX X @ @21 
errr rr nate re cence n= 1 1 NEW 
1X X X XK X 1X X X X Xl _ BLOCK 
1 1 1 I+l 
BLOCK I+1 1X X X XK X 1X X X X Xl 
NROWI1= 5 1 1 1 
NCOLI1= 5 1X xX X X X 1X X X X Xl 
Tn renee teen nse n eo 1-------------1 


INTEGER IPIVOT(NROWL) ,LAST, IP,J,JMAX, JMAXP1,M,MMAX 
REAL AI (NROWL,NCOLI) ,AI1(NROWI1,NCOLI1) 
MMAX = NROWI - LAST 
JMAX = NCOLI - LAST 
IF (MMAX .LT. 1 .OR. JMAX .LT. 1) RETURN 
PUT THE REMAINDER OF BLOCK I INTO AT1 
DO 10 M=1,MMAX 
IP = IPIVOT(LAST+M) 
DO 16 J=1,JMAX 
10 AI1(M,J) = AI(IP,LAST+J) 
IF (JMAX .EQ. NCOLI1) RETURN 
ZERO OUT THE UPPER RIGHT CORNER OF AIl 
JMAXP1 = JMAX + 1 
DO 26 J=JMAXP1,NCOLI1 
DO 26 M=1,MMAX 
20 AI1(M,J) = @. 
RETURN 
END 


BLK24700 
BLK24800 
BLK2490@ 
BLK25060@ 
BLK25160 
BLK252006 
BLK25300 
BLK25460 
BLK25506 
BLK25600 
BLK25 700 
BLK25 800 
BLK2590¢ 
BLK26000 
BLK26106¢ 
BLK2620@ 
BLK2630@ 
BLK264060 
BLK26500 
BLK266060 
BLK26 700 


BLK268060@ 
BLK26900 
BLK2 7600 
BLK27100 
BLK27200 
BLK273060 
BLK27490 
BLK27500 
BLK27600 
BLK2770@ 
BLK278@@ 
BLK2 7940 
BLK28000 
BLK2810@ 
BLK2826@ 
BLK283060 
BLK28400 
BLK28500 
BLK2 86606 
BLK28700 
BLK2 88060 
BLK2 8900 
BLK29000 
BLK29160 
BLK2920@ 
BLK29300 
BLK294060 
BLK2956@ 
BLK29600 
BLK29760@ 
BLK2980@ 
BLK2990@ 
BLK30000 
BLK30100@ 
BLK30200 
BLK3030@ 
BLK30400 
BLK30500 
BLK30600 
BLK30700 
BLK30800@ 
BLK30900 
BLK31000 
BLK3114@ 
BLK3126@ 
BLK31300 
BLK3144@ 
BLK3150@ 
BLK31600 
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SUBROUTINE SBBLOK ( BLOKS, INTEGS, NBLOKS, IPIVOT, B, X ) 


CALLS SUBROUTINES SUBFOR AND SUBBAK. 


qgaaqangnaanaanananna 


aaa 


AQAANMQAAAAARAANANAANAANAARAAAA 


i?) 


SUPERVISES THE SOLUTION (BY FORWARD AND BACKWARD SUBSTITUTION) OF 
THE LINEAR SYSTEM A*X = B FOR X, WITH THE PLU FACTORIZATION OF A 
ALREADY GENERATED IN FCBLOK.. INDIVIDUAL BLOCKS OF EQUATIONS 
ARE SOLVED VIA SUBFOR AND SUBBAK. 


PARAMETERS 
BLOKS, INTEGS, NBLOKS, IPIVOT ARE AS ON RETURN FROM FCBLOK. 
B THE RIGHT SIDE, STORED CORRESPONDING TO THE STORAGE OF 
THE EQUATIONS. SEE COMMENTS IN S LV BLK FOR DETAILS. 
Xx SOLUTION VECTOR 


INTEGER INTEGS(3,NBLOKS),IPIVOT(1), I, INDEX, INDEXB, INDEXX,J,LAST, 


x NBP1,NCOL,NROW 
REAL BLOKS (1) ,B(1),X(1) 


FORWARD SUBSTITUTION PASS 


INDEX = 1 
INDEXB = 1 
INDEXX = 1 
DO 2@ I=1,NBLOKS 
NROW = INTEGS(1,1) 
LAST = INTEGS(3,1) 
CALL SUBFOR(BLOKS (INDEX) , IPIVOT (INDEXB) ,NROW, LAST, B(INDEXB) , 
* X (INDEXX) ) 
INDEX = NROW*INTEGS(2,1) + INDEX 
INDEXB_= INDEXB + NROW 
INDEXX = INDEXX + LAST 


20 
BACK SUBSTITUTION PASS 


NBP1 = NBLOKS + 1 
DO 3@ J=1,NBLOKS 
I = NBP1 - J 
NROW = INTEGS(1,I) 
NCOL = INTEGS (2,1) 
LAST = INTEGS(3,1) 
INDEX = INDEX - NROW*NCOL 
INDEXB = INDEXB - NROW 
INDEXX = INDEXX - LAST 
CALL SUBBAK(BLOKS (INDEX) , PIVOT (INDEXB) ,NROW,NCOL, LAST, 
* X (INDEXX) ) 


nou ou 


3¢ 


RETURN 
END 


SUBROUTINE SUBFOR ( W, IPIVOT, NROW, LAST, B, X ) 
CARRIES OUT THE FORWARD PASS OF SUBSTITUTION FOR THE CURRENT BLOCK, 
I.E., THE ACTION ON THE RIGHT SIDE CORRESPONDING TO THE ELIMINATION 
CARRIED OUT IN F AC TR B_ FOR THIS BLOCK. 

AT THE END, X(J) CONTAINS THE RIGHT SIDE OF THE TRANSFORMED 
IPIVOT(J)-TH EQUATION IN THIS BLOCK, J=1,...,NROW. THEN, SINCE 
FOR I=1,...,NROW-LAST, B(NROW+L) IS GOING TO BE USED AS THE RIGHT 
SIDE OF EQUATION I IN THE NEXT BLOCK (SHIFTED OVER THERE FROM 


THIS BLOCK DURING FACTORIZATION), IT IS SET EQUAL TO X(LAST+I) HERE. 


PARAMETERS 
W, IPIVOT, NROW, LAST ARE AS ON RETURN FROM FACTRB. 
B(J) IS EXPECTED TO CONTAIN, ON INPUT, THE RIGHT SIDE OF J-TH 
EQUATION FOR THIS BLOCK, J=1,...,NROW. 
B(NROW+J) CONTAINS, ON OUTPUT, THE APPROPRIATELY MODIFIED RIGHT 
SIDE FOR EQUATION J IN NEXT BLOCK, J=1,...,NROW-LAST. 


X(J) CONTAINS, ON OUTPUT, THE APPROPRIATELY MODIFIED RIGHT 


SIDE OF EQUATION IPIVOT(J) IN THIS BLOCK, J=1,...,LAST (AND 


EVEN FOR J=LAST+1,...,NROW). 


INTEGER IPIVOT(NROW), IP,JMAX,K 
DIMENSION B(NROW + NROW-LAST) 
REAL W(NROW, LAST) ,B(1) ,X(NROW) 
IP = IPIVOT(1) 

X(1) = BCIP) 

IF (NROW .EQ. 1) 

DO 15 K=2,NROW 


GO TO 99 


BLK31700 
BLK31800 
BLK3196@ 
BLK32000 
BLK3210@ 
BLK32200 
BLK32 300 
BLK3240606 
BLK32500 
BLK3260@ 
BLK32706 
BLK32800 
BLK32900 
BLK33000 
BLK33100 
BLK3320@ 
BLK3330@ 
BLK33400 
BLK3350@ 
BLK33600 
BLK33700 
BLK33800 
BLK3390@ 
BLK340600 
BLK34100 
BLK34200 
BLK34300 
BLK34400 
BLK 34500 
BLK3460@ 
BLK34760 
BLK34800 
BLK34900 
BLK 35000 
BLK35100 
BLK35200 
BLK35 300 
BLK35400 
BLK35500 
BLK356060 
BLK35700 
BLK35800 
BLK35900 
BLK 36000 
BLK3610@ 
BLK 362060 
BLK36 300 


BLK3640@ 
BLK36500 
BLK36600 
BLK36760 
BLK368060 
BLK36900 
BLK37000 
BLK37100 
BLK3720@ 
BLK37300 
BLK37400 
BLK3750@ 
BLK37600 
BLK377060 
BLK37800 
BLK3790@ 
BLK380600 
BLK381060 
BLK3820@ 
BLK38300 
BLK38400 
BLK3850@ 
BLK 38600 
BLK3870@ 
BLK38800 
BLK3890@ 
BLK39060 
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IP = IPIVOT(K) 
JMAX = AMIN@(K-1,LAST) 
SUM = @. 


DO 14 J=1,JMAX 


14 SUM = W(IP,J)*X(J) + SUM 
15 X(K) = B(IP) - SUM 
C 
Cc TRANSFER MODIFIED RIGHT SIDES OF EQUATIONS IPIVOT(LAST+1),..., 
Cc IPLVOT(NROW) TO NEXT BLOCK. 
NROWML = NROW - LAST 
IF (NROWML .EQ. @) GO TO 99 
LASTP1 = LAST+1 
DO 25 K=LASTP1,NROW 
25 B(NROWML+K) = X(K) 
99 RETURN 
END 
SUBROUTINE SUBBAK ( W, IPIVOT, NROW, NCOL, LAST, X ) 
C CARRIES OUT BACKSUBSTITUTION FOR CURRENT BLOCK. 
Cc 
C PARAMETERS 
C W, IPIVOT, NROW, NCOL, LAST ARE AS ON RETURN FROM FACTRB. 
C X(1),...,X(NCOL) CONTAINS, ON INPUT, THE RIGHT SIDE FOR THE 
Cc EQUATIONS IN THIS BLOCK AFTER BACKSUBSTITUTION HAS BEEN 
Cc CARRIED UP TO BUT NOT INCLUDING EQUATION IPIVOT(LAST). 
Cc MEANS THAT X(J) CONTAINS THE RIGHT SIDE OF EQUATION IPI- 
Cc VOT(J) AS MODIFIED DURING ELIMINATION, J=1,...,LAST, WHILE 
C FOR J .GT. LAST, X(J) IS ALREADY A COMPONENT OF THE SOLUT- 
Cc ION VECTOR. 
C X(1),...,X(NCOL) CONTAINS, ON OUTPUT, THE COMPONENTS OF THE SOLUT- 
¢ ION CORRESPONDING TO THE PRESENT BLOCK. 
C 
INTEGER IPIVOT(NROW),LAST, IP,J,K,KP1 
REAL W(NROW,NCOL) ,X(NCOL), SUM 
K = LAST 
IP = IPIVOT(K) 
SUM = @. 
IF (K .EQ. NCO) GO TO 4 
KP1 = K+1 
2 DO 3 J=KP1,NCOL 
5 SUM = W(IP,J)*X(J) + SUM 
4 X(K) = (X(K) - SUM)/WCIP,K) 
IF (K .EQ. 1) RETURN 
KP1 = K 
K = K-1 
IP = IPIVOT(K) 
SUM = @. 
GO TO 2 
END 
SUBROUTINE DTBLOK ( BLOKS, INTEGS, NBLOKS, IPIVOT, IFLAG, 
* DETSGN, DETLOG ) 
C COMPUTES THE DETERMINANT OF AN ALMOST BLOCK DIAGONAL MATRIX WHOSE 
C PLU FACTORIZATION HAS BEEN OBTAINED PREVIOUSLY IN FCBLOK. 
C %*** THE LOGARITHM OF THE DETERMINANT IS COMPUTED INSTEAD OF THE 
C DETERMINANT ITSELF TO AVOID THE DANGER OF OVERFLOW OR UNDERFLOW 
C INHERENT IN THIS CALCULATION. 
Cc 
C PARAMETERS 
C BLOKS, INTEGS, NBLOKS, IPIVOT, IFLAG ARE AS ON RETURN FROM FCBLOK. 
C IN PARTICULAR, IFLAG = (-1)**(NUMBER OF INTERCHANGES DUR- 
C ING FACTORIZATION) IF SUCCESSFUL, OTHERWISE IFLAG = @. 
C DETSGN ON OUTPUT, CONTAINS THE SIGN OF THE DETERMINANT. 
Cc DETLOG ON OUTPUT, CONTAINS THE NATURAL LOGARITHM OF THE DETERMI- 
C NANT IF DETERMINANT IS NOT ZERO. OTHERWISE CONTAINS @. 
Cc 
INTEGER INTEGS(3,NBLOKS) ,IPIVOT(1),IFLAG, I,INDEXP,IP,K,LAST 
REAL BLOKS (1) ,DETSGN, DETLOG 
GC 
DETSGN = IFLAG 
DETLOG = 


IF (IFLAG “EQ. 0) 
INDEX = @ 


RETURN 


BLK39100 
BLK39260 
BLK39300 
BLK39400 
BLK3950@ 
BLK39600 
BLK3970@ 
BLK39 800 
BLK39909 
BLK4G000@ 
BLK49160 
BLK40200 
BLK49300 
BLK40400 
BLK40500 
BLK496006 


BLK4076@ 
BLK40860 
BLK4096@ 
BLK41600 
BLK4110@ 
BLK41260 
BLK41360 
BLK4140@ 
BLK41500 
BLK41600 
BLK4176@ 
BLK418060 
BLK4196@ 
BLK42600 
BLK42160 
BLK42200 
BLK42300 
BLK424060 
BLK42500 
BLK4260@ 
BLK4270@ 
BLK4280@ 
BLK42900 
BLK43000 
BLK4316@ 
BLK43200 
BLK4 3300 
BLK4 3400 
BLK43500 
BLK4360@ 
BLK43700 
BLK43800 


BLK43900 
BLK44900 
BLK44100 
BLK44206@ 
BLK44300 
BLK44460 
BLK4450@ 
BLK44600 
BLK4476@ 
BLK4486@ 
BLK44960 
BLK4500@ 
BLK45160 
BLK45200 
BLK45300 
BLK45406 
BLK45500 
BLK45600 
BLK4570@ 
BLK4586@ 
BLK459@@ 
BLK46000 
BLK461006 
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2 


INDEXP = @ 
DO 2 I=1,NBLOKS 
NROW = INTEGS(1,1) 
LAST = INTEGS (3,1) 
DO 1 K=1,LAST 
IP = INDEX + NROW*(K-1) + IPIVOT(INDEXP+K) 
DETLOG = DETLOG + ALOG(ABS(BLOKS (IP) )) 
DETSGN = DETSGN*SIGN(1. ,BLOKS (IP) ) 
INDEX = NROW*INTEGS(2,I) + INDEX 
INDEXP = INDEXP + NROW 


RETURN 
END 


C TEST PROGRAM FOR THE SOLVEBLOK PACKAGE SOLVES AN 11TH ORDER LINEAR 


C ALMOST BLOCK DIAGONAL SYSTEM. 


DIMENSION BLOKS (61),B(16),X(11), IPIVOT(16) , INTEGS (15) 


C NROW NCOL LAST 
DATA INTEGS/ 3, 4, 2 
2 so Dag S73 
3 wat cg, Oise fk 
4 ee ee ser ome 
5 , 4, 4, Gl 
DATA BLOKS /.1,.2,-1., 2.,-.2,.3, -.1,-.2,-.3, -.1,4.,.3 
2 Oey 4,305. Ooysh5cdy O23 =5e5=05 
3 feOycSn avg. “HdbyAecy -meOs so esta. “Sekai a 
4 90.50.5553, G-,0.,-.3, $.,0.,.3, O.,0.,7. 
5 @ 20.,.2,6 ’ OY) 77 2, 1, sO. 9-22,- 1, 
5 @.,0.,8.,-.1/ 
DATA B /1.94,3.04,-.83, @.,-3.54,2.75, 1.32,2.35,1.96, 
2 2*9.,1.52, 2%*6.,.78,2.46 / 
NBLOKS = 5 
N= 11 
CALL SLVBLK ( BLOKS, INTEGS, NBLOKS, B, IPIVOT, X, IFLAG ) 
ERROR = @. 
DO 1@ I=1,N 


B(I) = FLOAT(12-1)/1@. - X(1) 
1@ ERROR = AMAX1(ERROR,ABS(B(I))) 
WRITE (6,610) IFLAG,ERROR, (IPIVOT(I),I=1,16), (I,X(1),B(I) ,I=1,N)BLK49800 


610 FORMAT (28H CHECKOUT SOLVEBLOK ROUTINES/ 


* 
* 
* 


* 


611 


8H IFLAG =,12,17H, MAXIMUM ERROR =,E9.4// 
9H IPIVOT =,5(2X, 312) ,12// 
27h I X(1) 
CALL DTBLOK ( BLOKS, INTEGS, NBLOKS, IPIVOT, IFLAG, 
DETSGN, DETLOG ) 
DET = DETSGN*EXP (DETLOG) 
ERROR = DET - 2.418821899E6 
WRITE (6,611) DET,ERROR 
FORMAT (//14H DETERMINANT =,E15.8,11H 
STOP 
END 


ERROR(I) /(13,F11.5,E13.5)) 


ERROR = ,E11.5) 


BLK46200 
BLK46 300 
BLK46400 
BLK46500 
BLK 46600 
BLK4670@ 
BLK46 8060 
BLK46900 
BLK47000 
BLK47160 
BLK47260 
BLK47 300 


BLK47400 
BLK475060 
BLK47600 
BLK47760 
BLK47800 
BLK479@0 
BLK48000 
BLK48160 
BLK482060 
BLK48300 
BLK48400 
BLK48500 
BLK48660 
BLK48700 
BLK48800 
BLK48900 
BLK49600 
BLK49100 
BLK49 200 
BLK49 300 
BLK49400 
BLK49500 
BLK49600 
BLK49 7060 
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BLK50000 
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BLK50400 
BLK50500@ 
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BLK510060 


546-P 8- 


0 


COLLECTED ALGORITHMS FROM ACM 


547-P1 - 0 


ALGORITHM 547 
Fortran Routines for Discrete Cubic Spline 
Interpolation and Smoothing [E1], [E3] 


CHARLES S. DURIS 
Drexel University 


_ Key Words and Phrases: discrete splines, discrete cubic splines, discrete natural splines, 
interpolation, smoothing 
CR Categories: 5.12, 5.13 
Language: Fortran 


DESCRIPTION 


1. Introduction 


Two Fortran subroutines, DCSINT and DCSSMO, are presented here for discrete 
cubic spline interpolation and smoothing. The theory for discrete cubic spline 
interpolation is given by Lyche in [5, 6]. The theory for discrete natural cubic 
spline smoothing is given by the author in [2]. For most applications continuous 
splines (see [3, 4, 7]) are probably more appropriate than discrete splines. Discrete 
spline interpolation and smoothing are worth considering for problems involving 
functions defined on discrete equally spaced points, or when difference quotients 
are available as data rather than derivatives. Possible areas of application are 
discrete time series analysis, computer routines for plotting data, and actuarial- 
and demographic-type data analysis. 

For both discrete cubic spline interpolation and smoothing we direct our 
attention to the problem of approximating a function g(f) defined on an interval 
[v1, Tn]. The values g(7;) = g: are specified for i = 1, 2,...,, where 7; < Ti+1. For 
many applications and for deriving the equations in Sections 2 and 3, it is 
convenient to assume that g(t) is defined on a discrete point set Ty = 
{to, ti, ..., tu} where t; = 7: + jh for some fixed step size h > 0, and also that the 
7’s belong to Ty. Neither the theory nor the routines DCSINT and DCSSMO 
require that the 7;’s belong to Ty. The only mandatory restriction on the 7,’s is 
Ti << Ti41. 

Discrete cubic splines defined on [11, t:] with nodes (or knots) A, = {71, 72, 

.» Tn} are functions S(t) having the form S(t) = S;(¢) where 


Si(é) = gi + b(t — 7) + et — 7)? + dit — 7° (1) 
for ¢ © [ri Ti+1] (i.e., S(t) is piecewise cubic). The S,(é)’s satisfy the joining 
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conditions 
Si(tist) = Sini(ti+1), (2) 
HV + A)Si(ti41) = $(V + A)Sini(Ti41), (3) 
VASi(ti+1) = VASi+1(Ti41), (4) 


where Af(x) = f(x + h) — f(x) and Vf(x) = f(x) — f(x — h). Conditions (3) and (4) 
should be recognized as requiring the matching up of the first central and the 
second central differences at i+: for adjacent cubics. 

Subroutine DCSINT constructs the discrete cubic spline function on the 
interval [71, t,] which interpolates the data (7;, g;) for 7 = 1, 2,..., mn and satisfies 
one of the three following end conditions: 


I. The first central divided difference end conditions 


1(V+A)S(T1) ay 1 (V + A)S(t) 
oo = Si and ar 


for specified values of S{? and S?. 
Il. The second central divided difference end conditions 


= 5” 


for specified values of S{ and S®). 
III. The periodic end conditions 


4(V + A)S(11) = $(V + A)S(t) and VAS(71) = VAS(7z) 


where we assume the data are periodic (g; = gn). 


In formulating discrete natural cubic spline smoothing, we assume g(t) is 
defined on a discrete point set T7. Subroutine DCSSMO constructs the function 
S(t) which smooths through the data (7;, g:;) for i = 1, 2,..., n in the sense that 
(see [3, 7, 8, 9]) 


n M--1 
o(f) =p  Wifr) — ad + ¥ (Ware)? (5) 


is minimized for f(¢) = S(é). This S(¢) turns out to be a discrete natural cubic 
spline (VAS(71) = VAS(r,) = 0). In (5) the W,’s are positive weights specifying the 
relative importance of the data, and p > 0 specifies the amount of smoothing in 
comparison to data fitting. If p is small, the smoothness of the approximation is 
emphasized at the expense of closely fitting the data. If p is large, the discrete 
natural cubic spline more closely fits the data at the expense of smoothness. In 
particular, as p approaches infinity, the smoothing discrete natural spline ap- 
proaches the interpolating discrete natural spline. 

Sections 2 and 3 describe the equations for constructing the discrete cubic 
splines for interpolating and smoothing, respectively. Those readers mainly 
interested in seeing how to use subroutines DCSINT and DCSSMO may turn 
directly to Sections 4 and 5. Section 6 describes how to construct test examples, 
and Section 7 presents estimates for execution times. 


2. Discrete Cubic Spline Interpolation 


The discrete cubic spline S(¢) = S,(¢) for ¢ € [7i, ti41] for i = 1, 2,...,m — 1 where 
S,{t) is given in (1). A better form for deriving equations is to represent S,(¢) using 
factorial polynomials as follows: 


Sit) = git b(t — 1) + edt — r)(t — 11 — h) 
+ dit — 1. + h)(t — ti) (t -- t1 — A). (6) 

The gi, c;, and d; in (6) are the same as those found in (1), but 
hi = 6; — csh — dh’. (7) 


COLLECTED ALGORITHMS (cont.) 
The joining conditions (2), (3), and (4) together with S(r,) = g, give the equations 


yvici + (ni + Ni+1) Ci+1 + yi+1Ci+2 = se? = g!?] (8) 
fori=1,2,...,n — 3, where H; = ti41 — 7:, 
h? 
yi = H; - i’ (9) 
h? 
ni = 2H; + — 10 
2 eh (10) 
gf = gltin, 7] = Bes ae a) (11) 


The remaining linear equations for the c;’s come from the end conditions. The 
complete system of linear equations denoted by 


Ac=g (12) 


is now described for the three types of end conditions, I, II, and III. These systems 
are modified forms of the systems found in Lyche [6]. 


I. The first central divided difference end conditions have 


m ¥1 ] eters 0 
yi (m + 12) Y2 
Y2 (n2 + 3) ‘ 

A=]. . (13a) 

: gob he 

Yn-2 (n 277 1) Yn-1 

0 ues 0 apse ae 
c = (C1, C2, ..., Cn)’, (13b) 
g& = 3(g!? — St, gf -— gl, ..., 1 — es, SY - gM). (13c) 


The c, in (13b) is VAS(t,)/2h? and is introduced to preserve symmetry. 
II. The second central divided difference end conditions have 


{m1 + 2) ye 0 tee 0 
Y2 (n2 + 73) _3 . 
O Y3 Soe ‘ 
A= 8: 0 (14a) 
: : Yn—2 
0 eee 0) Yn-2 (Mn-2 te Nn-1) 
C = (C2, C3, 22.5 Cn-1)", (14b) 
= (28 — 2! - nS? 2 — 28,82 ty aS®). (Ide) 


In a it is shown that the natural end conditions Sf? = S® = 0 produce the 
function which interpolates the given data and minimize Y%;' [VAw(¢,)]’. 
III. The periodic end conditions have 


(Mn-1 + 1) y1 QO «-- 0 Yn-1 
y1 (m1 + 72) Y2 0 
0 y2 . 
A= ; rats : 
7 0 (15a) 
Yn-2 


Yn-1 0 ses 0: Yn-2 (Mn-2 a Nn—-1) 
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C= (C1, C2,..., Cn-1)', (15b) 


g = 3(g!? — ef, ef? -— ef, ..., @1 — gn). (15¢) 


The matrix of the system is tridiagonal except for the yn-1 in the remote 
corners. This type of linear system is solved in DCSINT using a method described 
by Bjorck and Golub in [1], which uses a rank one modification to make (15a) 
tridiagonal. The number of multiplications and divisions needed to solve system 
(15) is about 9n. 

The linear systems arising for end conditions I, II, and III are all positive 
definite and symmetric with nonnegative coefficient matrices A. In all three cases 
the matrix is strictly diagonally dominant. The infinity condition number for the 
matrix A in (14a) and (15a) is bounded by (see [2]) 

maxi(Hi+1 + Hi) 


-j Seren Need ee vara et ee 
cond..(A) = ||A||..||A~ || = 3 min Hig + Hi)’ (16a) 


For (13a) the bound is 
max;(H;.1 + Hi) 


fore) A = 3 zy ya eee Ae 16b 
cond..(A) min<H) (16b) 
Hence the A matrices are normally very well conditioned. 
Once the c;’s are known, the 6; and d; in (1) are given by 
d; = ee (17) 
| 3H: [Ci+1 cil, 
Hi; 
b= gP - 3 (2¢; + Ci+;) (18) 
fori = 1, 2,...,n— 1 (for the periodic case c, = ci). 


In [5] Lyche gives error bounds for discrete cubic spline interpolation using (I) 
the first central divided difference end conditions. These bounds involve differ- 
ences for g(t). He also gives an O(h”) bound for the distance between the discrete 
cubic spline and the continuous cubic spline interpolating the same data. 


3. Discrete Cubic Spline Smoothing 


In [2] the author develops the theory for discrete natural spline smoothing. This 
type of smoothing was originally studied by Whittaker [8] in a slightly different 
form (see also [9, pp. 303-316]). The equations for the cubic case can be derived 
without too much difficulty by developing the cubic discrete analog of Theorem 
14.1 given by Greville in [3]. This discrete analog is now stated. 


THEOREM 3.1. Let p, h, and W;, 1 = 1, 2,...,n, be positive real numbers. Then 


there exists a unique function S(t) defined on Tu = {to, hh, ..., tu} which 
minimizes 
n M-1 
o( f(t) = X Wilf) — Bi) + 3 (WAS. (19) 
= ay 
This S(t) is the unique discrete natural cubic spline (see (1) or (6)) satisfying 
6h? 
S(ti) = gi — OW, [d: — di-1] (20) 


where di = (Ci+1 — ¢:)/(8H;) and do = d, = 0. 


The resulting system of linear equations for the c,’s in (1) or (6) is obtained 
from (14a-c) and (17) by putting S{? = S? = 0 and replacing the g;’s used in 
computing the g{”’s by g; = S(7:), where S(7;) is given by (21). 

This linear system is five banded, positive definite, and symmetric (see [2]). 
The following equations describe this system. For i = 2, 3, ..., n — 1 with the 
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understanding that co = ¢1 = Cn = Cn+i = 0, 


Bi-1¢;-2 + [yi-1 — (Bi-1 + Bi + €:-1) Jei-1 + [(qi-a + 9) + (28; + 6-1 + €/) Je 


+ [yi — (Bi t+ Bist + &)]cis1 + Bisicite = 3(g — g™). (21) 
The y:, 7:, and gi(1) are given by (9)-(11), 
6h? 
3, =———— (22) 
oW.Hi-1Hi 


for i = 1, 2,...,n with Ho = A, = 1 (Ai = Ti+1 — 71), and 


(BiHii-1 + Bi+1Hi+1) 
= a al (23) 
fori=1,2,...,n—1. 
The discrete cubic spline smoothing the data (7;, g;) for i = 1, 2,..., n has the 
form S(t) = S,(t) for ¢ € [t:, Ti+1] with 


Sit) = 8 + b(t — 1:) + c(t — 7i)? + dit — 7:)° (24) 


where the c,’s solve (22), (17) gives di, (18) gives b;, and g; = S(7;) is given in (21). 

The five-banded, positive definite, symmetric matrix arising from (22) need not 
be strictly diagonal dominant, as was the case for interpolation. The condition 
number of this matrix becomes large as p approaches 0. This is to be expected, 
since the solution to the smoothing problem is not unique when p = 0. From (23) 
and (24) we can see that as p becomes large, (22) takes the form of the equations 
for interpolation. Hence (22) is still reasonably conditioned for many useful values 
of p. 


4. Examples for DCSINT 


We now show how DCSINT is used to find the discrete cubic spline interpolating 
the data (h = 0.1, n = 6) 


Oak WN 1 ~. 
_ 
Oo 
i) 
i) 


for the three end conditions: 
I. First central divided difference 


L(V + A)S() _ 
2 h 
II. Second central divided difference 
VAS(71) VAS(tn) 
a a 
(These are the natural end conditions.) 
III. Periodic 
S(11 —h) =S(t.—h), — S(71) = S(t), S(11 + h) = S(t +h). 
A possible dimension statement for the calling program is 
DIMENSION TNODE (10), G(10), B(10), C(10), D(10) 


The nodes 7; are stored in array TNODE. Note that TNODE (I) must be less 
than TNODE (I + 1). The data values g; are stored in array G, and N = 6 and H 
= 0.1. 


(V+ A)S(t») _ 


1 
=i = 0. 
0, 5 h 0.0 


= 0.0. 
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|. First Central Divided Difference End Conditions 
Put IENT = 1, ENDI = —1.0, and ENDN = 0.0 and call the subroutine as follows: 
CALL DCSINT (IENT, H, N, TNODE, G, ENDI, ENDN, B, C, D) 


The solution is found in arrays G, B, C, and D. 


Solution for I: 
I Interval G(D) B(I) C(I) D(I) 
1 [0.5,0.7] 1.0 1.751037 —18.76556 75.10376 
2 [0.7,1.0] 0.5 0.9306393 2.629669 —42.44052 
3 [1.0, 1.5] 2.0 4.736782 —11.89979 8.852451 
4 [1.5, 2.1] 2.5 —0.4001307 1.378888 —3.501484 
5 [2.1, 2.5] 2.0 —2.697525 —4,923788 13.54401 


In particular, the discrete cubic spline S(r) for + = 1.2 is given by 
S(1.2) = 2.0 + 4.736782 x T — 11.89979 x T? + 8.852451 x T° 
where T = (1.2 — 1.0) 


lt. Second Central Divided Difference End Conditions 
Put IENT = 2, ENDI = 0.0, and ENDN = 0.0, and call DCSINT as before. 


Solution for Il: 


(25) 


TI Gd) B(I) c(i) D() 

1 1.0 —4.069061 0.0 39.22695 

2 0.5 1.416796 23.53593 —38.63974 

3 2.0 4.640036 —11.23984 7.9195391 
4 2.5 —0.5627829 0.6394691 —1.817308 
5 2.0 —1.798219 —2.631689 2.193076 


ill. Periodic End Conditions 


Put [ENT = 3. ENDI and ENDN may contain anything. Call DCSINT as before. 
(The subroutine assumes G(1) = G(N), so the content of G(N) is never used.) 


Solution for I: 


I GQ B(D) C(I) D(D) 

1 1.0 —3.801780 —2.156043 43.32474 

2 0.5 1.357985 23.83881 —38.99586 

3 2.0 4.663832 —11.25748 7,.8596271 
4 2.5 —0.6051248 0.5319628 —1.520514 

5 2.0 —1.624539 —2.204966 0.04076882 


5. An Example for DOCSSMO 


We now show how DCSSMO is used to find the discrete cubic natural spline 
which smoothes through the data used in Section 4. No end conditions are 
needed. A possible dimension statement for the calling program is 


DIMENSION TNODE(10), G(10), GS(10), B(10), (10), D(10), WGS(10) 


The subroutine was run for p = RHO = 0.01 and for p = RHO = 1.0. The weights 
W;,, stored in array WGS, were taken to be Wi = Ws = We = 2.0, We = 2.5, W3 
= 1.0, and W, = 1.5. The subsolution is called as follows: 


CALL DCSSMO (H, N, TNODE, G, WGS, RHO, GS, B, C, D) 


The two solutions are as follows. 


p = 0.01: 
I GS(I) B(I) c(i) D(D 
1 0.7307289 1.536621 0.0 0.8975704 
2 1.045234 1.667059 0.5385422 —1.374241 
3 1.556716 1.611752 —0.6982756 —0.6354344 
4 2.108594 0.4271141 —1.651427 0.3430809 
5 1.844454 ~1.189260 —1.033881 0.8615685 
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p = 1.0: 
I GS(D B(D) C(I) Dd) 
1 0.9166568 —2.545056 0.0 27.78108 
2 0.6298941 1.329906 16.66866 —26.34149 
3 1.817824 3.915267 —7.038706 4.021049 
4 2.518413 —0.06161821 —1.007132 —0,5822141 
5 1.993115 —1.921916 —2.055118 1.712599 


Theoretically, the discrete cubic spline smoothing the given data will approach, 
in the limit as p goes to infinity, the discrete natural cubic spline interpolating 
these data. From the graphs given in Figure 1 we can see that the discrete 
smoothing spline for p = 1.0 more closely follows the discrete natural interpolating 
spline than does the discrete smoothing spline for p = 0.01. 


p=© interpolation 


1.5 2.5 
Fig. 1 
6. Test Data 


Any values may be used for test data gi, i = 1, 2,...,m, when interpolating. The 
correctness of the interpolating solution provided by DCSINT can be checked by 
verifying that the end conditions are satisfied and that 


Silt) = Si+i(2) (26) 


for t = Tia. — h, Ti+1; and 7Ti+1 + h. 
Test data for smoothing (DCSSMO) can be constructed from the discrete 
natural cubic spline represented in the form 


S(t) = ao + a(t — 71) + ) Bit — 71 — h)(t — 71) (t — 7) + A)oOi(t) (27) 
im] 
where 


_ 40 for t<7; 
oe = {? for t2=7; 


and the £;,’s satisfy 
x Bi = 0, x biti = 0. (28) 


The data values g; which produce the S(¢) in (28) as the solution to the smoothing 
problem are given by 


Bi 
(0 Wi) 


for i = 1, 2,...,n. This follows from Theorem 3.1, eq. (20). 


&i = S(7i) + 3! 


(29) 
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7. Timing Estimates 


DCSINT and DCSSMO have been run on the IBM 370/168 computer at the 
UNI-COLL Corporation in Philadelphia. The subroutines have been compiled 
and run using the WATFIV compiler and the Fortran G and H compilers. Timing 
estimates were made for the codes compiled by the G and H compilers. These are 
now listed. 


DCSINT 

For IENT = 1 (first central divided difference end conditions), 
T; = 5.3N X 107° seconds. 

For IENT = 2 (second central divided difference end conditions), 
T, = 5.7N X 107° seconds. 

For IENT = 3 (periodic end conditions), 
T; = 7.3N X 107~° seconds. 


The above timing estimates are about right for the G compiler but are approxi- 


mately 20 or 25 percent too large for the H compiler using the two-mode 
optimization parameter. 


DCSSMO 
Ts = 11N X 10° seconds. 


Again this estimate is right for the G compiler but about 20 or 25 percent too 
large for the H compiler. 
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ALGORITHM 

SUBROUTINE DCSSMO(H, N, TNODE, G, WGS, RHO, GSMO, B, C, D) DcS_ 10 
C pcs 2@ 
C THIS SUBROUTINE COMPUTES THE DISCRETE NATURAL CUBIC pcs = 33 
C SPLINE DEFINED ON THE INTERVAL (TNODE(1),TNODE(N)) WHICH pcs §4@ 
C SMOOTHS THROUGH THE DATA (TNODE(I),G(1)),I=1,2,...,N. pcs 50 
C N MUST BE 2 OR GREATER. THE NODES MUST SATISFY TNODE(1) pcs_—s«6@ 
C .LT.TNODE(I+1). THE SOLUTION S(T) FOR T IN THE INTERVAL pcs’ 70 
C (TNODE(1I),TNODE(I+1)) IS GIVEN BY pcs ss 88 


COLLECTED ALGORITHMS (cont.) 


er CO 


QRaARQANAMAANAANAANANMNAAMAAMAAMNAMAANAANANAANN 


QAANRKAN 


INPUT PARAMETERS(NONE OF THE INPUT PARAMETERS ARE CHANGED 


S (T)=GSMO (1)+B (I) * (T-TNODE(T))+ 
C(I) *(T-TNODE (L) )**2+D (1) * (T-TNODE (I) ) **3 


DIMENSION TNODE(N), G(N), WGS(N), GSMO(N), B(N), C(N), D(N) 


BY THIS SUBROUTINE) 


- THE STEP SIZE USED FOR THE DISCRETE CUBIC SPLINE 


- NUMBER OF NODES (TNODE) AND DATA VALUES (G) 


TNODE - REAL ARRAY CONTAINING THE NODES (TNODE(I).LT. 


TNODE (I+1)). 


G - REAL ARRAY CONTAINING THE DATA VALUES. 

WGS - REAL ARRAY CONTAINING THE WEIGHTS WGS(T) 
CORRESPONDING TO THE DATA (TNODE(I),G(I)). 

RHO - SIMPLE REAL VARIABLE CONTAINING THE POSITIVE 


PARAMETER FOR VARYING THE SMOOTHNESS OF THE FIT. 


IF RHO IS SMALL SMOOTHNESS IS EMPHASIZED. 
IF RHO IS LARGE DATA FITTING IS EMPHASIZED. 


OUTPUT PARAMETERS 


GSMO - REAL ARRAY CONTAINING THE SMOOTHED VALUES OF 


B 


C 


THE DATA G(I),I=1,2,....,N. 

- REAL ARRAY CONTAINING THE COEFFICIENTS B(I) FOR 
THE TERMS (T-TNODE(I)). 

- REAL ARRAY CONTAINING THE COEFFICIENTS C(I) FOR 
THE TERMS (T-TNODE(I))**2. 

- REAL ARRAY CONTAINING THE COEFFICIENTS D(I) FOR 
THE TERMS (T-TNODE(I))**3. 


IF (N.EQ.2) GO TO 18¢@ 


NI =N-1 
N2 =N1-1 
N3 =N2-1 


THE RIGHT HAND SIDE OF THE LINEAR SYSTEM FOR THE 
C(I)'S WILL NOW BE CONSTRUCTED. 


DO 1¢ I=1,N 
C(I) = G(I) 


16 CONTINUE 


DO 2@ I=1,N1 
C(I) = (C(I+1)-C(I)) / (TNODE (I+1)-TNODE (I) ) 


26 CONTINUE 


DO 30 I=1,N2 
C(I) = 3.0*(C(I+1)-C(I)) 


3@ CONTINUE 
THE RIGHT HAND SIDE IS NOW IN ARRAY C. 


THE P.D. 5 BANDED SYMMETRIC MATRIX WILL NOW BE CONSTRUCTED. 


THE THREE NEEDED DIAGONALS WILL BE STORED IN ARRAYS 
GSMO,B,D. 


H2 = H*H 

H3 = H2*H 
= 6.0*H3/RHO 

TNODE(2) - TNODE(1) 

TNODE(3) - TNODE(2) 


H1I3 


R6/ (WGS (1) *HI3) 

BETA4 = R6/(WGS (2) *HI3*HI4) 

EPS3 = (BETA3+BETA4*HI4) /H1I3 
H2DHI = H2/HI4 

ETA4 = HI4 + HI4 + H2DHI 

IF (N.EQ.3) GO TO 6¢@ 

HI5 = TNODE(4) - TNODE(3) 

BETA5 = R6/ (WGS (3) *HI4*HI5) 

EPS4 = (BETA4*HI3+BETA5*HI5) /HI4 
GSMO(1) = ETA3 + ETA4 + BETA4 + BETA4 + EPS3 + EPS4 
P = H2DHI + BETA4 + BETAS + EPS4 
B(1) = HI4 - P 

IF (N.EQ.4) GO TO 5@ 

DO 4¢ I=2,N3 


HI3 = HI4 
HI4 = HI5 
HI5 = TNODE(I+3) - TNODE(I+2) 


ETA3 = ETA4 


DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCs 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
pcs 
DCS 
DCS 
DCs 
pcs 
DCS 
DCS 
DCs 
DCS 
DCS 
DCS 
DCS 
pcs 
DCS 
DCS 
DCS 
pcs 
Dcs 
pcs 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
pcs 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCs 
pcs 
DCS 
DCS 
DCS 
DCS 
pcs 
DCS 
DCS 


96 
166 
110 
120 
130 
140 
15¢ 
16¢ 
17@ 
18¢ 
190 
200 
210 
220 
230 
240 
250 
260 
270 
280 
290 
300 
310 
320 
33¢ 
340 
350 
360 
370 
380 
3906 
460 
410 
420 
430 
440 
450 
46@ 
470 
480 
496 
5060 
51¢ 
526 
530 
540 
55¢@ 
560 
570 
580 
590 
606 
61¢ 
62¢ 
630 
640 
650 
66¢ 
67¢ 
680 
690 
700 
710 
720 
730 
740 
750 
760 
770 
780 
790 
800 
810 
820 
830 
840 
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4g 
5¢ 


H2DHI = H2/HI4 
ETA4 = HI4 + HI4 + H2DHI 


BETA3 = BETA4 

BETA4 = BETAS 

BETAS = R6/(WGS (I+2) *HI4*HI5) 
EPS3 = EPS4 


EPS4 = (BETA4*HI3+BETAS*HL5) /HI4 
D(I-1) = BETA4 
P = H2DHI + BETA4 + BETAS + EPS4 
B(L) = HI4 - P 
GSMO(I) = ETA3 + ETA4 + BETA4 + BETA4 + EPS3 + EPS4 
CONTINUE 
HI3 = HI4 
HI4 = HI5 
ETA3 = ETA 
ETAG = HI4 + HI4 + H2/HI4 
BETA4 = BETAS 
EPS3 = EPS4 


6@ BETAS = R6/(WGS(N)*HI4) 


EPS4 = (BETA4*HI3+BETA5) /HI4 
GSMO(N2) = ETA3 + ETA4 + BETA4 + BETA4 + EPS3 + EPS4 


C THE P.D. 5 BANDED SYMMETRIC MATRIX IS COMPLETE. 
C THE SYSTEM OF LINEAR EQUATION WILL NOW BE SOLVED FOR THE 
Cc CcCI)'S. 


IF (N.GT.3) GO TO 7¢ 
C(1) = C(1)/GSMO(1) 
GO TO 15¢ 


7@ IF (N.GT.4) GO TO 8@ 
C(1) = (C(1)*GSMO(2)-C (2) *B(1) ) / (GSMO (1) *GSMO (2)-B (1) **2) 
C(2) = (C(2)-C(1)*B(1) ) /GSMO (2) 
GO TO 15¢ 

C THIS SOLVE THE 5 BANDED SYSTEM WHEN K=N-2.GT.3. 

86 K = N2 
Kl =K-1 
K2-=Ki-=j 
K3 =k? = 1 


C THE 5 BANDED MATRIX WILL NOW BE FACTORED. 


90 
1060 


11@ GSMO(K) = GSMO(K) - GSMO(K2)*(D(K2)**2) - GSMO(K1)*(B(K1)**2) 


B(1) = B(1)/GSMO(1) 
D(1) = D(1)/GSMO(1) 
P = GSMO(1)*B(1) 
GSMO(2) = GSMO(2) - P*B(1) 
B(2) = (B(2)-P*D(1))/GSMO(2) 
IF (K.EQ.3) GO TO 1106 
D(2) = D(2)/GSMO(2) 
IF (K.EQ.4) GO TO 160 
DO 9@ I=3,K2 
Il=I-1 
oie a oy ee 
P = GSMO(I1)*B(I1) 
GSMO(L) = GSMO(I) - GSMO(12)*(D(12)**2) - P*B(I1) 
B(L) = (B(1)-P*D(I1))/GSMO(I) 
D(I) = D(1)/GSMO(I) 
CONTINUE 
P = GSMO(K2)*B(K2) 
GSMO(K1) = GSMO(K1) - GSMO(K3)*(D(K3)**2) - P*B(K2) 
B(K1) = (B(K1)-P*D(K2) ) /GSMO(K1) 


C FACTORIZATION COMPLETE. 
C CARRY OUT FORWARD AND BACKWARD SUBSTITUTION. 


126 


13¢ 


146 


C{2) = C(2) - B(1)*C(1) 
DO 12@ I=3,K 


Il=I-1 

I2=1I-2 

C(I) = C(I) -— BCI1)*C(I1) - D(12)*C(12) 
CONTINUE 


DO 13@ I=1,K 

C(I) = C(L)/GSMO(I) 
CONTINUE 
C(K1) = C(K1) — B(K1)*C(K) 
DO 14@ I=2,K1 


J=K-I 
C(J) = C(I) = B(J)*C(J+1) - D(J)*C(J+2) 
CONTINUE 


C THE 5 BANDED SYSTEM HAS BEEN SOLVED.THE SOLUTION IS IN 


DO 130 I=1,K 
C(I) = C(1)/GSMO(I) 


DCS 
DCS 
pcs 
DCs 
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DCS 
DCS 
DCS 
DCS 
DCS 
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DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
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DCS 
DCS 
DCS 
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DCS 
DCS 
DCS 
DCS 
pcs 
DCs 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
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DCS 
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DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
DCS 
pcs 
DCs 
DCS 
DCS 
DCS 
DCS 
pcs 


850 

860 

870 

880 

890 

960 

91¢ 

920 

930 

940 

95¢ 

960 

970 

98¢ 

990 
1000 
1910 
192¢ 
1630 
1040 
105¢ 
1060 
1670 
1680 
1690 
11060 
1119 
112¢ 
113@ 
114¢ 
115¢ 
1160 
1170 
118¢ 
1196 
1290 
121¢ 
122¢ 
1236 
1240 
1250 
12606 
127@ 
128¢ 
1296 
13066 
1319 
1326 
1330 
1340 
1350 
1360 
137 
1380 
139¢ 
1400 
1410 
1420 
143@ 
1440 
145¢ 
146¢ 
1476 
1480 
1490 
1500 
151¢ 
1520 
1530 
1546 
1550 
156@ 
1570 
1580 
1500 
151¢ 
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C 
C 
C 


Cc 


13@ CONTINUE 
C(K1) = C(K1) - B(K1)*C(K) 
DO 14@ I=2,K1 
J=K-TI 
C(J) = C(J) - B(J)*C(J+1) - D(J)*C(J+2) 
14¢ CONTINUE 
THE 5 BANDED SYSTEM HAS BEEN SOLVED.THE SOLUTION IS IN 
ARRAY C. THE COEFFICIENTS GSMO, B, C, AND D WILL NOW BE 
SET UP. 
15@ CCN) 0.¢ 
D(N) = 0.0 
C(N1) = C(N2) 
HK1 = TNODE(N) - TNODE(N1) 
D(N1) = -C(N1)/(3.@*HK1) 
GSMO(N) = G(N) + R6*D(N1)/WGS(N) 
IF (N.EQ.3) GO TO 17@ 
DO 16@ I=2,N2 


K=N-TI 

Kl =K+1 

HK2 = HK1 

HK1 = TNODE(K1) - TNODE(K) 


C({K) = C(K-1) 
D(K) = (C(K1)-C(K))/(3.@*HK1) 
GSMO(K1) = G(K1) — R6*(D(K1)-D(K) )/WGS (K1) 
B(K1) = (GSMO(K1+1)-GSMO(K1))/HK2 - HK2*(C(K1)+C(K1)+C(K1+1))/ 
* 3.0 
166 CONTINUE 
170 C(1) = 0.0 
HK2 = HK1 
HK1 = TNODE(2) - TNODE(1) 
D(1) = (C(2)-C(1))/(3.6*HK1) 
GSMO(2) = G(2) - R6*(D(2)-D(1))/WGS (2) 
GSMO(1) = G(1) - R6*D(1)/WGS(1) 
B(2) = (GSMO(3)-GSMO(2))/HK2 — HK2*(C(2)+C(2)+C(3))/3.0 
B(1) = (GSMO(2)-GSMO(1))/HK1 - HK1*(C(1)+C(1)+C(2))/3.0 
THE DISCRETE CUBIC SMOOTHING SPLINE IS NOW COMPLETE. 
RETURN 


C THE TRIVIAL CASE WHEN N=2 IS HANDLED HERE. 


OO OOO AOOMOAOMaAOAMA AN OOO oO tr ea 


18@ GSMO(1) 
GSMO (2) 
B(1) = ¢ 
C(1) = 9 
D1) = @ 
RETURN 
END 


= G(1) 
= G(2) 
G(2)-G(1))/ (INODE (2) -TNODE (1) ) 
¢ 
do 


SUBROUTINE DCSINT(IENT, H, N, TNODE, G, END1, ENDN, B, C, D) 


THIS SUBROUTINE COMPUTES THE DISCRETE CUBIC SPLINE 
DEFINED ON THE INTERVAL (TNODE(1),TNODE(N)),WHICH INTER- 
POLATES THE DATA (TNODE(I),G(I)),I=1,2,...,N. WE REQUIRE 
THAT TNODE(L).LT.TNODE(I+1). END1 AND ENDN CONTAIN THE 
VALUES OF THE END CONDITIONS BEING USED. 


IF IENT=1,THE FIRST CENTRAL DIVIDED DIFFERENCE END 
CONDITIONS ARE BEING USED. 


IF IENT=2,THE SECOND CENTRAL DIVIDED DIFFERENCE END 
CONDITIONS ARE BEING USED. 


IF IENT=3,THE PERODIC END CONDITIONS ARE BEING USED. 
FOR THIS CASE THE CONTENTS OF G(N), END1,AND ENDN ARE 
IGNORED. 


FOR ALL THREE END CONDITIONS N MUST BE GREATER THAN OR 
EQUAL TO 2. 


THE DISCRETE CUBIC SPLINE IS REPRESENTED BY PIECEWISE 
CUBIC POLYNOMIALS. FOR T IN THE INTERNAL (TNODE(I) ,TNODE 
(I+1)) THE CUBIC SPLINE IS 


S(T)=G(I)+B (1) * (T—-TNODE (I) ) 
+C (1) * (T-TNODE (1) ) **2 
+D (1) * (T-TNODE (LI) )**3 
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DIMENSION TNODE(N), G(N), B(N), C(N), D(N) 


INPUT PARAMETERS (NONE OF THESE PARAMETERS 
ARE CHANGED BY THIS SUBROUTINE.) 


TIENT - SPECIFIES END CONDITIONS WHICH ARE IN EFFECT. 


H - THE STEP SIZE USED FOR THE DISCRETE CUBIC SPLINE. 

N - NUMBER OF NODES (TNODE) AND DATA VALUES (G). 
(N.GE.2) 

TNODE ~ REAL ARRAY CONTAINING THE NODES (TNODE(I).LT. 
TNODE (I+1)). 

G - REAL ARRAY CONTAINING THE INTERPOLATING DATA. 


END1 = END CONDITION VALUE AT TNODE(1). 
ENDN - END CONDITION VALUE AT TNODE(N). 


OUTPUT PARAMETERS 


B - REAL ARRAY CONTAINING COEFFICIENTS OF 
(T-TNODE(I)) ,I=1,2,....,N-1. 

Cc - REAL ARRAY CONTAINING COEFFICIENTS OF 
(T-TNODE(I))**2,I=1,2,...,N-1. 

D - REAL ARRAY CONTAINING COEFFICIENTS OF 


(T-~TNODE(L))**3,I=1,2,...,N-1. 


SPECIAL CASES ARE ACCOUNTED FOR HERE. 
LF (N.EQ.2 .AND. IENT.EQ.3) GO TO 226 


H2 = H*H 

Nl =N-1 

IF (N.FQ.2 .AND. IENT.EQ.2) GO TO 180 
N2 = N1- 1 


THE SYMMETRIC TRIDIAGONAL(OR NEAR TRIDIAGONAL) LINEAR 
SYSTEM WILL NOW BE SET UP FOR THE APPROPRIATE END 
CONDITIONS 

HI = TNODE(2) - TNODE(1) 

H2DHI = H2/HI 

ETA2 = HI + HI + H2DHI 

GO TO (16, 40, 60), IENT 
IENT=1 - FIRST CENTRAL DIVIDED DIFFERENCE END CONDITONS 


1@ B(1) = ETA2 
D(1) = HI - H2DHI 
G2 = (G(2)-G(1))/HI 
C(1) = 3.@*(G2-END1) 


IF (N.EQ.2) GO TO 3¢ 
DO 2¢@ I=2,N1 
ETAL = ETA2 
Gl = G2 
HI = TNODE(I+1) - TNODE(I) 
H2DHI = H2/HI 


ETA2 = HI + HI + H2DHI 
B(I) = ETA] + ETA2 
D(I) = HI - H2DHI 


G2 = (G(I+1)-G(1))/HI 
C(I) = 3.0*(G2-G1) 
26 CONTINUE 
36 B(N) = ETA2 
C(N) = 3.06* (ENDN-G2) 
L=N 
SET UP FOR (1) FIRST CENTRAL DIVIDED DIFFERENCE END 
CONDITING COMPLETE.THE LINEAR EQUATIONS WILL BE NCW 
SOLVED. 
GO TO 110 
IENT=2 — SECOND CENTRAL DIVIDED DIFFERENCE END CONDITIONS 
SET UP. 
46 GAMMA = HI -— H2DHI 
G2 = (G(2)-G(1))/HI 
DO 5@ I=1,N2 
ETAL = ETA2 
Gl = G2 
HI = TNODE(I+2) - TNODE(I+1) 
H2DHI = H2/HI 
ETA2 = HI + HI + H2DHI 
B(I) = ETAl + ETA2 
D(I) = HI — H2DHI 
G2 = (G(1+2)-G(I+1))/HI 
C(I) = 3.0*(G2-G1) 
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Cc 


5@ CONTINUE 
C(1) = C(1) - GAMMA*END1/2.¢@ 
HI = TNODE(N) - TNODE(N1) 
GAMMA = HI - H2/HI 
C(N2) = C(N2) -— GAMMA*ENDN/2.@ 
STEP UP FOR (2) SECOND CENTRAL DIVIDED DIFFERENCE 


END CONDITIONS COMPLETE. THE LINEAR EQUATIONS WILL NOW 


BE SOLVED. 
IF (N2.EQ.1) GO TO 1466 
L = N2 
GO TO 11¢ 
IENT=3 -— PERIODIC END CONDITIONS SET UP. 
6@ B(1) = ETA2 
D(1) = HI - H2DHI 
DO 7@ I=2,N1 
ETAL = ETA2 
HI = TNODE(I+1) - TNODE(I) 
H2DHI = H2/HI 


ETA2 = HI + HI + H2DHI 
B(I) = ETAl + ETA2 
D(I) = HI - H2DHI 
C(I) = 0.0 
76 CONTINUE 

CT = D(N1) 

C(1) = CT 

C(N1) = CT 


B(1) = B(1) + ETA2 ~ CT 
B(N1L) = B(N1) - CT 
L=N1 
ITRANS = 1 
GO TO 12¢ 
8@ G1 = (G(N1)-G(N2) )/ (TNODE(N1)-TNODE (N2) ) 
G2 = (G(1)-G(N1) )/ (TNODE(N)-TNODE (N1) ) 
DEN = (1.@+C(1)+C(N1)) 
CT = 3.0*(G2-G1) 
BS1 = CT*C(N1) 


C(N1) = CT 

DO 9@ I=1,N2 
HI = TNODE(I+1) - TNODE(I) 
Gl = G2 
G2 = (G(I+1)-G(L))/HI 
CT = 3.6*(G2-G1) 
BS1 = BS1 + CT*C(L) 
C(I) = CT 

9% CONTINUE 


BS1 = BS1/DEN 

C(1) = C(1) - BSI 

C(N1) = C(N1) - BS1 

ITRANS = @ 

GO TO 14¢ 
THE SET UP AND MOST OF THE DETAILS FOR SOLVING THE 
LINEAR EQUQTION FOR (3) THE PERIODIC END CONDITIONS 
ARE COMPLETED. 


THE LINEAR EQUATION ARE SOLVED HERE. 
10@ C(2) = C(1)/B(1) 
GO TO 18¢ 
11@ ITRANS = @ 
12@ Ll =L-1 
DO 13@ I=1,L1 
T = D(1)/B(I) 
B(I+1) = BC(I+1) - T*D(LI) 
D(I) =T 
13¢@ CONTINUE 
THE LINEAR EQUATION SOLVER IS ENTERED AT THIS POINT 
IF THE LU FACTORIZATION HAS ALREADY BEEN DONE. 
14@ DO 15@ I=1,L1 
C(I+1) = C(I+1) - D(I)*C(1) 
15@ CONTINUE 
C(L) = C(L)/B(L) 
DO 16@ I=1,L1 
LI =hLh-1I1 
C(LI) = C(LI)/B(LI) - D(LI)*C(LI+1) 
16@ CONTINUE 
IF (ITRANS.GE.1) GO TO 8@ 
THE LINEAR SYSTEM HAS BEEN SOLVE FOR THE C-VECTOR 
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IF (LENT.EQ.3) C(N) = C(1) 
LF (LIENT.NE.2) GO TO 19¢ 
DO 17@ I=1,N2 
LI =N-I 
C(LI) = C(LI-1) 
17@ CONTINUE 
180 C(1) = END1/2.¢@ 
C(N) = ENDN/2.06 
C(1) 
C(2) 
TNODE(2) — TNODE(1) 
IF (N.EQ.2) GO TO 21¢ 
DO 26@ I=1,N2 
B(I) = (G(I+1)-G(1))/HI - HI*(C1+C1+C2)/3.@ 
D(I) = (C2-C1)/(3.@*HI) 
HI = TNODE(I+2) - TNODE(I+1) 
Cl = C2 
= C(I+2) 
206 CONTINUE 
210 GN = G(1) 
IF (LENT.NE.3) GN = G(N) 
B(N1L) = (GN-G(N1))/HI - HI*(C1+C1+C2)/3.0 
D(N1) = (C2-C1)/(3.@*HI) 


i?) 
ho 
tou ou 


THE INTERPOLATING DISCRETE CUBIC SPLINE HAS BEEN 
CONSTRUCTED. 
RETURN 
THE FOLLOWING HANDLES THE TRIVIAL PERIODIC CASE 
(IENT.EQ.3) WHEN N.EQ.2. 
220 B(1) = 6.6 
C(1) = @.@ 
D(1) = 9.0 
RETURN 
END 
TEST FOR DURIS ALGORITHM, JAN 1979 
DRIVER FOR DCSSMO 
THIS DRIVER USES SUBROUTINE DCSSMO TO COMPUTE THE 
DISCRETE NATURAL CUBIC SPLINE WHICH SMOOTHS THROUGH 
THE DATA (TNODE(I),G(I)),I=1,2,...,N AS SPECIFIED 
BY THE SMOOTHING PARAMETER RHO AND THE WEIGHTS WGS(I), 
Tat? aaa nt 


DIMENSION TNODE(2@), G(2@), B(20), C(2@), D(26), GSMO(2@), 


* WGS (2) 
THE NEXT READ STATEMENT BRINGS IN THE TOTAL NUMBER 


OF DATA POINTS N, THE STEP SIZE H , AND THE PARAMETER RHO 


SPECIFYING THE AMOUNT OF SMOOTHING DESIRED. 
READ (5,99999) N, H, RHO 
THE FOLLOW WRITE STATMENTS OUTPUT N,H,AND RHO AND 
PREPARES TO OUTPUT DATA AND SOLUTION. 
WRITE (6,99998) 
WRITE (6,99997) N, H, RHO 
THE NEXT DO LOOP READS IN THE DATA VALUES 
(TNODE(I),G(1)), AND THE WEIGHTS WGS(1) FOR 
I=1,2,...,N AND AT THE SAME TIME WRITES THIS DATA 
AS OUTPUT TO THE USER. 
DO 1@ I=1,N 
READ (5,99995) TNODE(1), G(1), WGS(I) 
WRITE (6,99996) I, TNODE(I), G(I), WGS(I) 
1@ CONTINUE 
SUBROUTINE DCSMO PARAMETERS H, TNODE,G,WGS, 
ARE AS SPECIFIED ABOVE. 
DRHO=RHO 
NN=N 
DO 5@ N=2,NN 
DO 4@ IRHO=1,3 
RHO=DRHO* 100 .** (IRHO-2) 
WRITE (6,99998) 
WRITE (6,99997) N, H, RHO 
DO 15 I=1,N 
WRITE (6,99996) I, TNODE(I), G(I), WGS(I) 
15 CONTINUE 
CALL DCSSMO(H, N, TNODE, G, WGS, RHO, GSMO, B, C, D) 
OUTPUT FROM DCSSMO IS GSMO(I),B(1I),C(I),AND D(I) FOR 
I=1,2,...,N-1. IN PARTICULAR THE DISCRETE CUBIC SPLINE 
ON THE INTERVAL (TNODE(1),TNODE(I+1)@ IS DESCRIBED BY 


DCS 182@ 
DCS 183¢ 
DCS 1840 
DCS 185¢ 
DCS 186¢ 
DCS 187¢ 
DCS 1880 
DCS 189¢ 
DCS 1900 
DCS 1916 
DCS 1920 
DCS 1930 
DCS 194¢ 
DCS 195¢@ 
DCS 196¢ 
DCS 1970 
DCS 198¢ 
DCS 199¢ 
DCS 20600 
DCS 2610 
DCS 2020 
DCS 2030 
DCS 2640 
DCS 2050 
DCS 2960 
DCS 2070 
DCS 2068¢ 
DCS 2690 
DCS 216¢ 
DCS 2110 
DCS 212¢ 
DCS 2130 
DCS 214¢ 


DU $0010 
DU $6026 
DU $6030 
DU 006046 
DU 00656 
DU 06066 
DU 060076 
DU 060680 
DU 00696 
DU 06160 
DU $011¢ 
DU $0126 
DU 006130 
DU 06146 
DU 00150 
DU $0166 
DU $0170 
DU 04180 
vU $0190 
DU 06260 
DU $621¢ 
DU $6226 


DU 00416 
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THE CUBIC POLYNOMIAL 


c 
C 
C S (T)=GSMO(I)+B (I) *(T-TNODE (I) )+ 
C C(1)*(T-TNODE (I) )**2+D (1) * (T-TNODE (1) ) **3 
C 
Nl =N-1 
C THE SOLUTION IS NOW PRINTED OUT BY THE FOLLOWING STATEMENTS 
WRITE (6,99994) 
DO 2@ I=1,N1 
WRITE (6,99993) I, GSMO(I), B(I), C(I), D(I) 
2@ CONTINUE 
WRITE (6, 99992) 
DO 3@ I=1,N1 
T=TNODE (I+1)-TNODE (I) 
SL=GSMO (I) 
SR=GSMO (L)+(B(I)+(C(L)+D(1)*T) #T) *T 
FL=B (I)+D(1) *H*H 
FR=FL+(2.*C(1)+3.*D (I) *T) *T 
DL=2.*C(I) 
DR=DL+6.*D(1)4*T 


WRITE (6,99993)1,SL,SR,FL,FR,DL,DR 
30 CONTINUE 
49 CONTINUE 
50 CONTINUE 

CALL TEST2 

STOP 


99999 FORMAT (116, 2E1@.2) 

99998 FORMAT (///5H DATA) 

99997 FORMAT (3H N=, 13, 2X, 2HH=, F1@.4, 3X, 4HRHO=, F1@.4 //5H I, 
* 3X, SHTNODE(I), 9X, 4HG(I), 7X, 6HWGS(I)) 

99996 FORMAT (13, 3E16.7) 

99995 FORMAT (3E1@.2) 

99994 FORMAT (//4@H DISCRETE NATURAL CUBIC SMOOTHING SPLINE//4H I , 
* 2X, 7HGSMO(I), 12X, 4HB(1), 16X, 4HC(I), 16X, 4HD(I)) 

99993 FORMAT (13, 6E17.7) 

99992 FORMAT(3H@ 1,14X, 6HVALUES ,18X,25HFIRST DIVIDED DIFFERENCES, 
1 9X,26HSECOND DIVIDED DIFFERENCES) 
END 


SUBROUTINE TEST2 
C DRIVER FOR DCSINT 
C THIS DRIVER USES SUBROUTINE DCSINT TO COMPUTE THE 
C DISCRETE CUBIC SPLINE WHICH ENTERPOLATES THE DATA 
C (TNODE(I),G(1I)),I=1,2,...,N SUBJECT TO THE END CONDITIONS 
C SPECIFIED BY IENT,END1,AND ENDN. 
c 

DIMENSION TNODE(26), G(2@), B(20), C(26), D(20) 
Cc 
C THE NEXT READ STATEMENT BRINGS IN THE NUMBER OF DATA 
C POINTS N AND THE DISCRETE CUBIC SPLINE STEP SIZE H. 
Cc 

READ (5,99999) N, H 

WRITE (6,99998) N, H 

WRITE (6,99997) 
C THE NEXT DO LOOP READS IN AND WRITES OUT THE DATA 
C VALUES (TNODE(I),G(I)),I=1,2...,N. 

DO 1@ I=1,N 

READ (5,99996) TNODE(I), G(I) 
WRITE (6,99995) IL, TNODE(I), G(I) 
1@ CONTINUE 

C THE END CONDITIONS ARE NOW READ IN. IENT SPECIFIES 
C THE TYPE OF END CONDITION(SEE SUBROUTINE COMMENTS) 
C AND END1 AND ENDN SPECIFY THE VALUES OF THE END CONDITIONS. 


READ (5,99994) LENT, END1, ENDN 
C SUBROUTINE DCSINT IS NOW CALLED. THE PARAMETERS 
C H,TNODE,G,END1,AND ENDN ARE AS SPECIFIED ABOVE 

NN=N 

DO 5@ N=2,NN 

WRITE (6,99998) N, H 

WRITE (6,99997) 

DO 15 I=1,N 

WRITE (6,99995) I, TNODE(I), G(I) 
15 CONTINUE 
DO 4@ IENT=1,3 


DU $0426 
DU 00430 
DU 00446 
DU $0456 
DU 00460 
DU 6647¢ 
DU 06486 
DU 06490 
DU $0500 
DU $651¢ 
DU 04526 
DU 0653¢ 
DU 06540 
DU $6550 
DU $0560 
DU $0576 
DU $0580 
DU $9590 
DU $9606 
DU $0610 
DU 00620 
DU $4630 
DU $0646 
DU $0650 
DU $0660 
DU $6670 
DU 006806 
DU $0696 
DU 006700 
DU 60710 
DU 06720 
DU $0730 
DU $0740 
DU 0675¢ 
DU $0766 
DU $0776 
DU 60786 
DU $6796 


DU $6860 
DU $0810 
DU $0820 
DU 90830 
DU 0684¢ 
DU $085¢ 
DU 0086¢ 
DU $0870 
DU $0880 
DU $089¢ 
DU $0906 
DU $091¢ 
DU 96926 
DU 60930 
DU $0946 
DU 6695¢ 
DU 06960 
DU $0970 
DU $0980 
DU $6996 
DU 61006 
DU $161¢ 
DU $1620 
DU $1036 
DU $1649 
DU $1065¢ 
DU 01660 
DU 91670 
DU 6168¢ 
DU $1690 
DU 011060 
DU $1116 
DU $1120 
DU $113¢ 
DU 4114¢ 
DU $115¢ 
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99999 
99998 
99997 
99996 
99995 
99994 
99993 
99992 
99991 


9999 FORMAT (3H@ 1,14X, 6HVALUES,18X,25HFIRST DIVIDED DIFFERENCES, 


CALL DCSINT(IENT, H, N, TNODE, G, END1, ENDN, B, C, D) 
THE END CONDITIONS IENT,END1,ENDN AND THE DISCRETE: 
CUBIC SPLINE SOLUTION TO THE INTERPOLATIONPROBLEM 
ARE NOW OUTPUTED BELOW. IN PARTICULAR THE DISCRETE 
CUBIC SPLINE ON THE INTERVAL (TNODE(I),TNODE(I+1) ) 


DESCRIBES BY THE CUBIC POLYNOMIAL 


S(T)=G (1)+B (1) *ARG+C (1) *ARG**2 
+D (1) *ARG**3 


WHERE ARG=(T-TNODE(I)). 


WRITE (6,99993) IENT, END1, ENDN 
WRITE (6,99992) 
Nl =N-1 
DO 26 I=1,N1 

WRITE (6,99991) I, G(I), B(I), C(1), D(1) 
CONTINUE 
WRITE (6, 99990) 
DO 3@ I=1,N1 
T=TNODE (I+1) -TNODE (I) 
SL=G (1) 
SR=G(1)+(B(1)+(C(1)+D(1)*T) *T) *T 
FL=B (1)+D(1) *H*H 
FR=FL+(2.*C(1)+3.*D(I)*T)*T 
DL=2.*C(I) 
DR=DL+6.*D(I)4T 
WRITE (6,99991)1,SL,SR,FL,FR,DL,DR 
CONTINUE 
CONTINUE 
CONTINUE 
RETURN 
FORMAT (116, E1@.2) 


FORMAT (///5H DATA//3H N=, 13, 2X, 2HH=, F10.5) 


FORMAT (2H I, 3X, SHTNODE(I), 1@X, 4HG(I)) 
FORMAT (2E1@.2) 

FORMAT (13, 3E16.7) 

FORMAT (11, 2E1@.2) 


FORMAT (///6H LENT=, 12, 2X, 5HEND1=, E16.7, 2X, 5SHEND2=, E16.7) 
FORMAT (/2H I, 3X, 4HG(I), 13X, 4HB(I), 13X, 4HC(I), 13X, 4HD(I)) 


FORMAT (13, 6E17.7) 


1 9X,26HSECOND DIVIDED DIFFERENCES) 


END 
7 @.1 100.¢ 
1.6 2.0 
¢.5 2.5 
2.0 1.6 
25 1.5 
2.0 2.0 
1.0 2.0 
@.1 2.0 
6 @.1 
1.9 
0.5 
2.9 
25 
2.0 
1.¢ 


2 6.001 0.002 


DU $116¢ 
DU $1176 
DU $1186 
DU 6119¢ 
DU $1200 
DU 91216 
DU $122¢ 
DU 01230 
DU $1246 
DU 0125¢@ 
DU 91260 
DU $1270 
DU $1280 
DU $1290 
DU $1306 
DU $131¢ 
DU $132¢ 
DU $133¢ 
DU $1340 
DU $135 
DU $1360 
DU $1370 
DU $138¢ 
DU 013990 
DU $1400 
DU 01410 
DU $142¢ 
DU 01430 
DU $1440 
DU 01450 
DU 0146¢ 
DU $1470 
DU 01486 
DU $1496 
DU $1500 
DU $1510 
DU $1520 
DU $1530 
DU 015490 
DU $1550 
DU 61566 
DU $1576 
DU 91580 
DU $1590 


DU 91610 
DU 016206 
DU 0163¢ 
DU $1640 
DU $165¢ 
DU $1660 
DU $1670 
DU $1680 
DU $1690 
DU 01700 
DU $171¢ 
DU $172¢ 
DU $1730 
DU 01740 
DU $1750 
DU $1766 
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ALGORITHM 548 
Solution of the Assignment Problem [H] 


GIORGIO CARPANETO and PAOLO TOTH 
University of Bologna, Italy . 


Key Words and Phrases: assignment problem, Hungarian algorithm 
CR Categories: 5.39, 8.3 
Language: Fortran 


DESCRIPTION 


Problem 


The algorithm presented in this paper solves the assignment problem of the 
following form: given an n X n cost matrix (a;;), find a permutation (C;) of 
integers 1,..., 2 that minimizes 


n 
T= YD) aia. 
i=1 


It is supposed, without loss of generality, that the elements of the cost matrix 
are nonnegative integers. 


Algorithm 

To give the reader a better understanding of the algorithm proposed below, we 

define: 

C; as the row assigned to column] (j = 1,..., 7); 

LG as the label of column J; if LC; = 0, column is unlabeled (j = 1,..., 7); 

LR; as the label of row 1; if LR; = 0, row 7 is unlabeled (i = 1,..., 7); 

T as the assignment cost; 

P; as the set containing the columns corresponding to the unassigned zero 
elements of row i of the cost matrix (1 = 1,..., 7); 

RH as the set containing the current not-completely-explored rows; 

U as the set containing the unassigned rows; 


first (s) as the first element of set s; 
next (s) as the element following the last considered element of set s; 
last (s) as the last element of set s. 


Step 1. [Initialization] 
Set C; = 0, for7 =1,...,7; 
sett U=60,N= {illsisn}. 

Step 2. [Reduction of the initial cost matrix] 
Set S; = minjen [ai,;], for all 7 € N; 
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set Q; = minjen [a;,; — S;], for alli € N; 
set aj; =a; -—S;-— Qi, forall iE N, JEN; 
set P; = {7 € N| ai; = 0}, for all i © N; set T = Vien (Se + Qe). 
Step 3. [Choice of the initial solution] 
Set z= 1. 
a. Set 7 = first {k € P;| C, = 0}; if7 exists, go to Step 3d. Otherwise, set 
J = first {Pi}. 
b. Set m = first {k € Pc,| Cy = 0}; if m exists, go to Step 3c. Otherwise, set 
J = next {P;}; if 7 exists, repeat Step 3b; if not, set U = U U {1}, go to Step 3e. 
c. Set Cn = Cj, Pe = Pc, U {J} — {m}. 
d. Set C; = i, P; = Pi — {7}. 
e. Ift<n, set i =i + 1, go to Step 3a. 
Step 4. [Search for a new assignment] 
If set U is empty, stop (the optimal assignment is given by vector (C;), the 
minimum cost is given by 7). Otherwise, set RH = ©; set LR; = LC; = 0, for k = 
1, 2,...,7; set r = first {U}, LR, = —1. 
a. If set P, is empty, go to Step 4c. Otherwise, if set P, has at least two elements, 
set RH = RH U {r}; in any case, set / = first {P,}. 
b. If LC, = 0, set LC, = r, if C; = 0, go to Step 6; if not, set r = C;, LR, = 1, go to 
Step 4a. Otherwise (LC; ¥ 0), if r © RH, go to Step 4d. 
c. If set RH is empty, go to Step 5. Otherwise, set r = first {RH}. 
d. Set 1 = next {P,}, if 1 = last {P,}, set RH = RH — {r}; in any case, go to Step 
Ab. 
Step 5. [Reduction of the current cost matrix] 
Set SLR = {1E N| LR; 4 0}, SUC = {7 E N| LC, = 0}. 
Set H = minieszr,jesuc [ai]. 
For all: € SLR, 7 © SUC: set ai; = ai; — H, if ai; = 0, set P; = P; U {7}, RH = 
RH vu {i}; 
For alli € N—SLR,j © N— SUC: if7 € Pi, set P; = P; — {7}; im any case set aj; 
=ai;+H. 
Set T = T + H, r= first {RH}, go to Step 4d. 
Step 6. [Assignment of a new row] 
Set C,=r, P, = P, — {1}; if LR, < 0, set U = U — {r}, go to Step 4. 
Otherwise, set / = LR,, P, = P, U {l}, r= LC), repeat Step 6. 


The efficiency of the algorithm is mainly due to the pointer technique utilized 
to locate the unexplored rows and the zero elements of the current cost matrix. 
It is worthwhile to note that, as far as storage requirement is concerned, for each 
set P; (1 = 1,..., ) only the pointer to the first element needs to be stored; in 
fact, if column / is contained in set P;, the corresponding element of the current 
cost matrix (i.e., a@j,;) is zero and it is thus possible to replace this element by the 
pointer to the column following 7 in set P;. 

We obtained a further improvement on the original Hungarian algorithm by 
modifying the choice of the initial solution, as described in Step 3 of the proposed 
algorithm. 


Program 


Fortran IV subroutine ASSCT, based on the algorithm previously presented, is 
completely self-contained and communication to it is made solely through the 
parameter list. The subroutine is called by means of the statement: 


CALL ASSCT (N, A, C, T). 
All the parameters are integer and their meanings are the following: 


Input: N = number of rows and columns of the cost matrix; 
A = cost matrix. 

Output: C = assignment vector; 
T = minimum assignment cost. 


After execution of subroutine ASSCT, the values of the elements of the cost 
matrix are changed. Vector C must be dimensioned at least at N; matrix A at 
least at (N, N + 1). As presently dimensioned, the size limitation for ASSCT is N 
<= 200. 


Table I. Cost Range 1-100 
B 
n Average Maximum Average Maximum Average Maximum 
50 0.16 0.20 0.21 0.31 0.23 0.33 
100 0.54 0.66 0.93 1.15 1.10 1.27 
150 0.96 1.10 2.10 2.81 2.79 3.42 
200 1.40 1.68 4,37 5.27 5.38 7.24 
Table II. Cost Range 1-1000 
B 
n Average Maximum Average Maximum Average Maximum 
50 0.41 0.51 0.56 0.78 0.60 0.89 
100 2.15 2.61 2.97 3.92 3.34 4.24 
150 4.55 6.28 6.60 8.37 7.24 8.42 
200 6.70 8.01 10.36 12.26 11.83 13.15 
Table III. Cost Range 1-10,000 
B 
n Average Maximum Average Maximum Average Maximum 
50 0.48 0.61 0.66 0.81 0.72 0.96 
100 3.71 4.60 5.78 749 6.80 9.55 
150 11.74 15.57 18.72 21.96 21.35 23.94 
200 19.85 25.40 32.69 43.52 42.63 48.16 
Table IV. Sparse Matrices, Cost Range 1-100, n = 200 
Number of 
coefficients 1500 2250 3000 3750 4500 
AP-AB 0.97 1.12 1.48 1.61 1.68 
PD-AAL 1.63 1.14 1.89 1.29 1.80 
SUPERT-2 1.26 1.57 1.98 2.17 2.53 
ASSCT 15.29 5.80 6.49 2.62 2.17 
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Computational Results 


Subroutine ASSCT was tested in a CDC 6600 with over 1500 random problems 
of varying sizes. No breakdown in the method occurred. 

To evaluate the efficiency of the proposed algorithm, the computing times of 
subroutine ASSCT were compared with those of the most efficient algorithms for 
solution of the assignment problem for dense matrices [1, 3]. 

Tables I, II, and III show the computing times corresponding to the algorithms: 


A: Subroutine ASSCT. 

B: Hungarian algorithm as presented in [5] and coded in Fortran IV by the 
authors. 

C: Algorithm presented in [3] (the Fortran IV program, coded by Bourgeois and 
Lassalle, is taken from the CDC library of CERN (Geneva, Switzerland). 


In Tables I, IT, and III the values of the cost matrix were generated as uniformly 
random integers in the ranges, respectively, 1-100, 1-1000, and 1-10,000. All codes 
were run on a CDC 6600. For each cost range, each algorithm, and each value of 
n, 20 different problems were solved, and the average and maximum computing 
times, expressed in seconds, are given. 

The tables show that subroutine ASSCT is always superior to the other codes, 
mainly for large values of n and for small ranges of costs. In addition, for all codes 
the computing times get worse with the increase in size of coefficients; in fact, 
when the size increases, the number of zero elements of the current cost matrix 
decreases. 
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In order to evaluate the effect of sparseness on the performance of the proposed 
algorithm, the same test problems considered by Barr, Glover, and Klingman in 
[2] were solved on the same machine (a CDC-6600). Subroutine ASSCT war 
compared with the most efficient codes for the solution of sparse assignment 
problems, viz., codes AP-AB, PD-AAL, and SUPERT-2 presented, respectively, 
in [2], [6], and [1]; the corresponding computing times, expressed in seconds, are 
given in Table IV.’ 

Table IV shows that the codes designed to solve sparse assignment problems 
are superior to subroutine ASSCT for very sparse matrices because this subrou- 
tine does not include any mechanism for taking advantage of sparsity. However, 
the trends of the computing times indicate that for fairly dense matrices the 
performance of the proposed algorithm greatly increases with respect to those of 
the other codes. 

Further details of the algorithm and extensive computational results are given 
in [4]. 
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ALGORITHM 
SUBROUTINE ASSCT ( N, A, C, T ) 10 
INTEGER A(260,201), C(206), CH(206), LC(200), LR(200), 20 
s LZ (206), NZ(260), RH(201), SLC(206), SLR(20@), 30 
* U(2@1) 4@ 
INTEGER H, Q, R, 8S, T 50 
EQUIVALENCE (LZ,RH), (NZ,CH) 60 
Cc 76 
C THIS SUBROUTINE SOLVES THE SQUARE ASSIGNMENT PROBLEM 80 
C THE MEANING OF THE INPUT PARAMETERS IS 90 
C N = NUMBER OF ROWS AND COLUMNS OF THE COST MATRIX, WITH 100 
Cc THE CURRENT DIMENSIONS THE MAXIMUM VALUE OF N IS 200 11¢ 
C A(I,J) = ELEMENT IN ROW I AND COLUMN J OF THE COST MATRIX 12¢ 
C ( AT THE END OF COMPUTATION THE ELEMENTS OF A ARE CHANGED) 13¢ 
C THE MEANING OF THE OUTPUT PARAMETERS IS 14¢ 
C C(J) = ROW ASSIGNED TO COLUMN J (J=1,N) 150 
C T = COST OF THE OPTIMAL ASSIGNMENT 160 
C ALL PARAMETERS ARE INTEGER 17@ 
C THE MEANING OF THE LOCAL VARIABLES IS 18¢ 
C A(I,J) = ELEMENT OF THE COST MATRIX IF A(I,J) IS POSITIVE, 19¢ 
Cc COLUMN OF THE UNASSIGNED ZERO FOLLOWING IN ROW I 1g 
C (I=1,N) THE UNASSIGNED ZERO OF COLUMN J (J=1,N) 21¢ 
Cc IF A(I,J) IS NOT POSITIVE 220 
C A(I,N+1) = COLUMN OF THE FIRST UNASSIGNED ZERO OF ROW I 230 
C (I=1,N) 240 
C CH(I) = COLUMN OF THE NEXT UNEXPLORED AND UNASSIGNED ZERO 25 
C OF ROW I (I=1,N) 260 
C LC(J) = LABEL OF COLUMN J (J=1,N) 2706 
C LR(I) = LABEL OF ROW I (I=1,N) 280 
C LZ(1) = COLUMN OF THE LAST UNASSIGNED ZERO OF ROW I(I=1,N) 29¢ 
C NZ(I) = COLUMN OF THE NEXT UNASSIGNED ZERO OF ROW I(I=1,N) 300 
C RH(I) = UNEXPLORED ROW FOLLOWING THE UNEXPLORED ROW I 310 
Cc (I=1,N) 320 
C RH(N+1) = FIRST UNEXPLORED ROW 330 
C SLC(K) = K-TH ELEMENT CONTAINED IN THE SET OF THE LABELLED 346 
C COLUMNS 350 


1 The times in Table IV were communicated to the authors by an anonymous referee who has given 
us permission to publish them. 
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C 
G 


C UCI) = UNASSIGNED ROW FOLLOWING THE UNASSIGNED ROW I 


C 
C 


C 
Cc 
C 
C 
G 
C 


C REDUCTION OF THE INITIAL COST MATRIX 


SLR(K) = K-TH ELEMENT CONTAINED IN THE SET OF THE LABELLED 


ROWS 


(1=1,N) 
U(N+1) = FIRST UNASSIGNED ROW 


THE VECTORS C,CH,LC,LR,LZ,NZ,SLC,SLR MUST BE DIMENSIONED 
AT LEAST AT (N), THE VECTORS RH,U AT LEAST AT (N+1), 


THE MATRIX A AT LEAST AT (N,N+1) 


INITIALIZATION 
MAXNUM = 1@**14 
NP1 = N+1 
DO 1¢ J=1,N 

C(J) = @ 
LZ(J) = @ 
NZ(J) = @ 
U(J) = @ 
16 CONTINUE 
U(NP1) = @ 
T=@ 


DO 40 J=1,N 
S = A(1,J) 
DO 26 L=2,N 


IF ( A(L,J) .LT. S ) S = A(L,J) 


20 CONTINUE 

T = T+S 

DO 3¢ I=1,N 

A(I,J) = A(I,J)-S 
36 CONTINUE 
4@ CONTINUE 
DO 7@ I=1,N 
Q = A(T, 1) 
DO 5@ L=2,N 


IF ( ACI,L) .LT. Q ) Q = ACI,L) 


5@ CONTINUE 


T = T+Q 
L = NPI 
DO 69 J=1,N 


A(I,J) = A(I,J)-Q 


IF ( A(I,J) .NE. @ ) GO TO 60 


A(I,L) = -J 
L=4J 

60 CONTINUE 

7@ CONTINUE 


C CHOICE OF THE INITIAL SOLUTION 


160 


K = NP1 
DO 14¢ I=1,N 
LJ = NP1 
J = -A(I,NP1) 
86 IF ( C(J) .EQ. @ ) GO TO 13¢ 
LJI = J 
J = -A(I,J) 
IF ( J .NE. @ ) GO TO 8@ 
LJ = NP1 
-A(I,NP1) 
C(J) 
= LZ(R) 
= NZ(R) 
( M .EQ. @ ) GO TO 11¢ 
( C(M) .EQ. @ ) GO TO 12¢ 
=M 
= -A(R,M) 
GO TO 106¢ 


90 


PHA Rew 
f= fy ey a ie eS 


Hc 


116 LJ = J 


J = -A(I,J) 
IF (J .NE. @ ) GO TO 96 
U(K) = 1 
K =I 
GO TO 14¢ 

120 NZ(R) -A(R,M) 
LZ (R) J 
A(R,LM) = 
A(R, J) 
A(R,M) 
C(M) = 


-J 
A(R,M) 
@ 


wi i 
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13@ C(J) =I1 1130 
A(I,LJ) = A(I,J) 114@ 

NZ(L) = -A(I,J) 115@ 

LZ(1) = LJ 1160 
A(I,J) = @ 117¢ 

14@ CONTINUE 1186 
C RESEARCH OF A NEW ASSIGNMENT 1196 
15@ IF ( U(NP1) .EQ. @ ) RETURN 1200 
DO 16@ I=1,N 121¢ 
CH(L) = @ 1226 

LC(I) = @ 1230 

LR(L) = @ 1246 

RH(I) = @ 1250 

16@ CONTINUE 1260 
RH(NP1) = -1 1270 
KSLC = @ 1286 
KSLR = 1 1296 

R = U(NP1) 13066 
LR(R) = -1 1314 
SLR(1) = R 132¢@ 

IF ( A(R,NP1) .EQ. @ ) GO TO 22 1330 

17@ L = -A(R,NP1) 1340 
IF ( A(R,L) .EQ. @ ) GO TO 18¢ 1350 

IF ( RH(R) .NE. @ ) GO TO 18 1366 
RH(R) = RH(NP1) 1376 
CH(R) = -A(R,L) 138¢ 
RH(NP1) = R 1390 

186 IF ( LC(L) .EQ. @ ) GO TO 26¢ 1406 
IF ( RH(R) .EQ. @ ) GO TO 21¢ 1410 

19% L = CH(R) 1420 
CH(R) = -A(R,L) 1430 

IF ( A(R,L) .NE. @ ) GO TO 18 1440 
RH(NP1) = RH(R) 145¢@ 
RH(R) = @ 1460 

GO TO 18¢ 147¢ 

206 LC(L) = R 148 
IF ( C(L) .EQ. 6 ) GO TO 360 1496 
KSLC = KSLC+1L 1500 
SLC(KSLC) = L 1510 

R = C(L) 1526 
LR(R) = L 1530 
KSLR = KSLR+1 1540 
SLR(KSLR) = R 155 

IF ( A(R,NP1) .NE. @ ) GO TO 1704 1560 

210 CONTINUE 1570 
IF ( RH(NP1) .GT. @ ) GO TO 356 1580 

CG REDUCTION OF THE CURRENT COST MATRIX 1590 
220 H = MAXNUM 1600 
DO 246 J=1,N 1616 

IF ( LC(J) .NE. @ ) GO TO 24¢ 1620 

DO 23@ K=1,KSLR 163 

I = SLR(R) 1640 

IF ( A(I,J) .LT. H ) H = A(I,J) 165@ 

236 CONTINUE 1660 
24@ CONTINUE 167@ 
T = T+H 1680 

DO 29% J=1,N 1690 

IF ( LC(J) .NE. @ ) GO TO 296 17066 

DO 28@ K=1,KSLR 1710 

I = SLR(K) 1726 

A(I,J) = A(1,J)-H 1730 

IF ( A(I,J) .NE. @ ) GO TO 280 1740 

IF ( RH(1) .NE. @ ) GO TO 250 1750 

RH(L) = RH(NP1) 1760 

CH(I) = J 1776 

RH(NP1) = 1 1780 

250 L = NPL 1790 
260 NL = -A(I,L) 1800 
IF ( NL .EQ. @ ) GO TO 276 181¢ 

L = NE 1820 

GO TO 26¢ 183 

270 A(I,L) = -J 1840 
280 CONTINUE 1850 
299 CONTINUE 1860 
IF ( KSLC .EQ. @ ) GO TO 350 1876 

DO 34@ I=1,N 188¢ 


IF ( LR(L) .NE. @ ) GO TO 34¢ 1896 
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DO 33@ K=1,KSLC 
J = SLC(K) 
IF ( A(I,J) .GT. 6 ) GO TO 3206 
L = NP1 
300 NL = - A(I,L) 
IF ( NL .EQ. J ) GO TO 31¢ 


310 ACI,L) = A(I,J) 


326 A(I,J) = A(I,J)+H 
336 CONTINUE 
34@ CONTINUE 
35@ R = RH(NP1) 
GO TO 19¢ 
C ASSIGNMENT OF A NEW ROW 
36@ C(L) =R 
M = NPL 
376 NM = -A(R,M) 
IF ( NM .EQ. L ) GO TO 38 


386 AC(R,M) = A(R,L) 


IF ( LR(R) .LT. @ ) GO TO 396 
L = LR(R) 
A(R,L) = A(R,NP1) 
A(R,NP1) = -L 
R = LC(L) 
GO TO 36¢@ 
39% U(NP1) = UCR) 
U(R) = 6 
GO TO 15¢ 
END 


196¢ 
1916 
192¢ 
1930 
1940 
1956 
1960 
1974 
1980 
1990 
2000 
2010 
20206 
2930 
2040 
2050 
2060 
2070 
2080 
20690 
2100 
2110 
2120 
2130 
2140 
2150 
2169 
2170 
2180 
2190 
2260 
2210 
2220 
2230 
2240 
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ALGORITHM 549 
Weierstrass’ Elliptic Functions [S21] 


ULRICH ECKHARDT 
University of Hamburg, Germany 


Key Words and Phrases: Weierstrass’ elliptic functions 
CR Categories: 5.12 
Language: Fortran 


DESCRIPTION 


Weierstrass’ Y-function and its derivative can be approximated in the complex 
plane by a rational expression as described in [38, 4]. The following programs 
evaluate these approximations for the case of a unit period parallelogram. They 
are written according to the rules given in [2]. 

Programs PEQ and PEQI1 evaluate Weierstrass’ Afunction in the equianhar- 
monic case for a unit period parallelogram defined by the complex numbers 


1 1 | Saree | 
2 =e ; 24/ = —. ; 
W 5 5 V8 i, (a) 5 +5 V3! 


(see [1, Sec. 18.13] for notation). Because of the periodicity of Weierstrass’ 
functions it is sufficient to calculate them only in the fundamental rectangle of all 
z=x+1y with 


1 1 V3 V3 


-—_—_—= ae 

2 2’ acca 

which implies | z| = V/7/4. The theoretical absolute error of the approximation in 
this rectangle can be estimated as in [3] by the following bounds: 


PEQ: 9.31 x 10°” 
PEQI: 4.594 x 10°*. 


Numerical experiments were performed on different computers in order to obtain 
the actual errors of the programs. For large values of | #| the actual error is 
mainly due to the limited word length of the computer, whereas for small | 7| the 
actual error approaches the theoretical error. Therefore a “mixed” error was 
calculated; it is the absolute error for | #| < 1 and the relative error elsewhere. 
The bounds for the mixed errors were obtained by comparing the programs with 
0-series evaluations for randomly and systematically chosen arguments. Each 
program was tested on the computers given in Table I for more than 20,000 
argument values. 
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Table I. Bounds for the Mixed Error for PEQ and PEQI! on Different Computers 


Mantissa length 
Computer Bits Decimal PEQ PEQ1 
IBM 370/168 56 16 2x 107% 2x10" 
(double precision) 
CDC Cyber 172 48 14 Tx 1078 7x 10% 
TR 440 38 11 2x 10° 3x 10° 


Table II. Bounds for the Mixed Error for PLEM and PLEM1 


Computer PLEM PLEM1 

IBM 370/168 4x 10°" 8x 10°! 
(double precision) 

CDC Cyber 172 6x 10-8 6x 10°" 

TR 440 4x 10° 5x 10° 

Theoretical absolute 4.482 x 107"” 8.033 x 107”” 
error 


The difference between the numerical accuracy obtainable by using full word 
length of the computer and the values given in Table I is due to 


(1) a loss of nearly one significant figure in computing powers of the variable 
z; 

(2) a loss of one significant figure in evaluating the first line of the last 
assignment statement in each program. 


Programs PLEM and PLEM1 evaluate Weierstrass’ Afunction and its deriv- 
ative in the lemniscatic case where 


2m = 1, 2w’ = i. 
The fundamental rectangle is defined by 
1 1 1 1 


x55, 55955 
so that | z| = 1/ /2. The theoretical absolute error as given in [4] and the actual 
mixed error which was found by numerical experiments are given in Table II. 

In using the programs it should be observed that the functions have poles at 
the lattice points 2wM + 2w’N. If z happens to coincide with one of these poles, 
an overflow occurs. This can be avoided by checking after the reduction of z (see 
comments in the program listings) whether the reduced value of z is close to zero. 

Full machine accuracy can be obtained in all programs by specifying the 
argument z and all its powers in greater precision and by performing all operations 
of the first line of the last assignment statement in double precision. 

Note. The programs are written in single precision. On IBM computers they 
should be declared as 


PEQ 
PEQI 
PLEM 
PLEM1 


The first declaration should be COMPLEX »* 16 and the second REAL +* 8. All 
constants and functions should be given in double precision. 


COMPLEX FUNCTION + 16(Z). 
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ALGORITHM 
COMPLEX Z, PLEM, PLEM1, CR, CI, P, Pl MAN 
REAL W2, LC, ALPHA, FP, FP1, EPS, EPS1, A MAN 
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Cc MAN 
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C AND 10.5 - 7.541 MAN 
Cc (SEE M. ABRAMOWITZ AND I. A. STEGUN& HANDBOOK OF MATHEMATICAL MAN 
Cc FUNCTIONS, 18.14 FOR CORRESPONDING FUNCTION VALUES) MAN 
Cc THE DRIVER PROGRAM PRINTS THE MAXIMAL RELATIVE ERRORS OF P AND P: MAN 
Cc MAN 
C HR IA IKI KIKI KAKI IKK RIKI KR RIERA KEIR RIKKI RII AIK IIR ISI IIR IR IMAN 
Cc MAN 
C MAN 
Cc EVALUATION OF CONSTANTS MAN 
C Sams ssss sess MAN 
C MAN 
LC = 2.6220575542921198164648396 MAN 
C MAN 
C LC IS THE LEMNISCATE CONSTANT MAN 
C MAN 
W2 = 2.@*LC/SQRT(2.0) MAN 
ALPHA = 1.0 + SQRT(2.@) MAN 
CR = (1.6,¢4.0) MAN 
CI = (@.6,1.@) MAN 
FP = 1.0/(W2*W2) MAN 
FP1 = FP/W2 MAN 
Cc MAN 
c RRA K KKK RAK MAN 
6 MAN 
Z = (@.25,0.0) MAN 
P = PLEM(Z) MAN 
Pl = PLEM1(Z) MAN 
EPS = CABS (P*FP-@. 5*ALPHA*CR) /CABS (P) MAN 
EPS1 = CABS (P1*FP1+ALPHA*CR) /CABS (P1) MAN 
Cc MAN 
C AAAKRRK RK KKK K MAN 
C MAN 
Z= (0.5,0.@) MAN 
P = PLEM(Z) MAN 
Pl = PLEM1(Z) MAN 
A = CABS (P*FP—@.5*CR) /CABS (P) MAN 
IF (A.GT.EPS) EPS = A MAN 
A = CABS (P1*FP1) MAN 
IF (A.GT.EPS1) EPSl1 =A MAN 
C MAN 
Cc Kk AK KKK KKK MAN 
Cc MAN 
Z= (@.5,0.5) MAN 
P = PLEM(Z) MAN 
Pl = PLEM1(Z) MAN 
A = CABS (P*FP) MAN 
IF (A.GT.EPS) EPS = A MAN 
A = CABS (P1*FP1) MAN 
IF (A.GT.EPS1) EPS1 =A MAN 
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Qa 


aaa 


AQAAQAAND 


aaaa 


kk K KR KK KKK 
Z = (@.25,0.25) 
P = PLEM(Z) 


Pl = PLEM1(Z) 

A = CABS (P*FP+ 0. 5*C1)/CABS (P) 

IF (A.GT.EPS) EPS = A 

A = CABS (P1*FP1-(CR+CI) /SQRT (2.6) )/CABS (P1) 
IF (A.GT.EPS1) EPS1 =A 


RekKRK KKK KK KK 


Z = (10.5,-7.5) 


THIS Z IS FOR TESTING THE REDUCTION TO FUNDAMENTAL PARALLELOGRAM. 
BECAUSE OF THIS REDUCTION, THE ERROR MIGHT BE AN ORDER OF 
MAGNITUDE GREATER THAN THE BOUND GIVEN IN THE TEXT 


= PLEM(Z) 

1 = PLEM1(Z) 

= CABS (P*FP) 

F (A.GT.EPS) EPS = A 
= CABS (P1*FP1) 


P 
P 
A 
I 
A 
IF (A.GT.EPS1) EPS1 =A 


WRITE (6,99999) 
WRITE (6,99998) EPS 
WRITE (6,99997) EPS1 
STOP 


99999 FORMAT (51H1 MAXIMAL RELATIVE ERROR FOR WEIERSTRASS P-FUNCTI, 


* 
& 


2HON/ 49H IN THE LEMNISCATIC CASE AT FIVE SAMPLE POINTS/4xX, 
50 (1H=) ) 


99998 FORMAT (////25H RELATIVE ERROR FOR P=, 5X, E1@.3) 
99997 FORMAT (//26H RELATIVE ERROR FOR Pl=, 4X, 19.3) 


QAaAaAA 


aaa 


QaQAAAND 


* 


* 


ee OF 


END 


COMPLEX FUNCTION PEQ(Z) 


WETERSTRASS: P-FUNCTION IN THE EQUIANHARMONIC CASE 
FOR COMPLEX ARGUMENT WITH UNIT PERIOD PARALLELOGRAM 


COMPLEX Z, Z2, Z4, Z6 
REAL ZR, ZI 
INTEGER M, N 


REDUCTION TO FUNDAMENTAL PARALLELOGRAM 


ZI = 1.1547005383792515E@*AIMAG(Z) + @.5E@ 

M = INT(ZI) 

IF (ZI.LT.QE@) M=M-1 

ZR = REAL(Z) - @.5EQ@*FLOAT(M) + @.5E@ 

N = INT(ZR) 

IF (ZR.LT.GE@) N=N- 1 

Z2 = Z - FLOAT(N) - (0.5E@,@. 86602540378443865EQ) *FLOAT (M) 


IF Z2=@ THEN Z COINCIDES WITH A LATTICE POINT, 
SINCE P HAS POLES AT THE LATTICE POINTS, 


A DIVISION ERROR WILL OCCUR 
Z2 = Z2*Z2 
Z4 = Z2*Z2 
Z6 = 24*2Z2 


PEQ = 1EQ@/Z2 + 6EQ@*Z4* (5EQ@+Z6) / (1E@-Z6)**2 + 24% 
(((((-2. 642766 2E-10*Z6+1.610954818E-8) *Z6+7. 38610752879E-6) * 
Z6+4 .3991444671178E-4) *Z6+7 .477288226490697E-2)* 
Z6-6. 84841532872992G1E-1) /(((( (6. 2252191 E-106*Z6+2.553314573E-7)* 
26-2 .619832920421E-5) *Z6-5.6444801847646E-4) * 
Z6+4 .5655534848206106E-2) *Z6+1EO) 

RETURN 

END 


PEQ 
PEQ 


PEQ 
PEQ 
PEQ 
PEQ 


PEQ 
PEQ 


PEQ 
PEQ 


549-P 4- 


0 


COLLECTED ALGORITHMS (cont.) 


AaAaAAND 
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C1 Cy C09 


aan 


ANRAAN 


ee He be Ft 


i ae ee 


COMPLEX FUNCTION PEQ1(Z) PEQ 
PEQ 

FIRST DERIVATIVE OF WEIERSTRASS: P-FUNCTION IN THE PEQ 
EQUIANHARMONIC CASE FOR COMPLEX ARGUMENT PEQ 
WITH UNIT PERIOD PARALLELOGRAM PEQ 
PEQ 

COMPLEX Z, Z3, Z6 PEQ 
REAL ZR, ZI PEQ 
INTEGER M, N PEQ 
PEQ 

REDUCTION TO FUNDAMENTAL PARALLELOGRAM PEQ 
PEQ 

ZI = 1.1547005383792515EQ@*AIMAG(Z) + 0.5E@ PEQ 
M = INT(ZI) PEQ 
IF (ZI.LT.GE@) M=M- 1 PEQ 
ZR = REAL(Z) -— @.5EQ@*FLOAT(M) + @.5E@ PEQ 
N = INT(ZR) PEQ 
IF (ZR.LT.GE@) N=N-1 PEQ 
Z3 = Z — FLOAT(N) - (@.5E@,@. 86662540378443865EQ) *FLOAT (M) PEQ 
PEQ 

IF Z3=@ THEN Z COINCIDES WITH A LATTICE POINT. PEQ 
SINCE P: HAS POLES AT THE LATTICE POINTS, PEQ 
A DIVISION ERROk WILL OCCUR PEQ 
PEQ 

Z3 = Z23*Z3*Z3 PEQ 
26 = Z3*Z3 PEQ 
PEQL = (((14EQ@*Z6+294EQ) *Z6+126EQ) *Z6—2EQ) / (Z3* (1LEG-Z6) **3) + PEQ 
Z3* ((((((-2. 955391 75E-9*Z6-2. 676469 3031E-7) *Z6+2.402192743346E-5) PEQ 
*Z6+1.9656661451391E-4) *Z64+1. 760135529461036E-2) * PEQ 
Z6+8 .10262434988226 36E-1) *Z6-2. 73936613149196804EO) / PEQ 
((((( (4.639776 3E-10*Z6+5 . 4134822 33E-8) *Z6-1. 56293298374E-6) * PEQ 
Z6-1.0393701076352E—4) *Z6+9. 5553182532237E-4) * PEQ 
Z6+9 .131106969646212E-2) *Z6+1EQ@) PEQ 
RETURN PEQ 
END PEQ 
COMPLEX FUNCTION PLEM(Z) PLE 
PLE 

WEIERSTRASS: P--FUNCTION IN THE LEMNISCATIC CASE PLE 
FOR COMPLEX ARGUMENT WITH UNIT PERIOD PARALLELOGRAM PLE 
PLE 

COMPLEX Z, Z2, Z4, Z6 PLE 
REAL ZR, ZI PLE 
INTEGER M, N PLE 
PLE 

REDUCTION TO FUNDAMENTAL PARALLELOGRAM PLE 
PLE 

ZR = REAL(Z) + 0.5E@ PLE 
ZI = AIMAG(Z) + @.5E@ PLE 
M = INT(ZR) PLE 
N = INT(ZI) PLE 
IF (ZR.LT.GE@) M=M- 1 PLE 
IF (ZI.LT.$E@) N=N-1 PLE 
Z2 = Z - FLOAT(M) - (@E@,1E@) *FLOAT(N) PLE 
PLE 

IF Z2=6 THEN Z COINCIDES WITH A LATTICE POINT. PLE 
SINCE P HAS POLES AT THE LATTICE POINTS, PLE 
A DIVISION ERROR WILL OCCUR PLE 
PLE 

Z2 = Z2*Z2 PLE 
Z4 = Z2*Z2 PLE 
Z6 = Z4*Z2 PLE 
PLEM = 1E@/Z2 + 4EQ@*Z2* (3EQG+Z4) / (1E@-Z24)**2 + ‘PLE 


Z2* ((((((((-7. 2331 08E-11*Z4+1. 71419727 3E-8) *Z4—-2 .5369036492E-7)* PLE 
Z4-7.9871020686 8E-6) *Z4+6. 48596906969 737E—4) *Z4+7 . 396246293629 38E-PLE 


3) *Z4+2 .912382768497244E-2) *Z44+7.1177297543136598E-1)* 


PLE 


Z4-2 .5463639935 38307 38E@) /((((((((5.1161516E-16*24+6 .61289468E-9) PLE 


*Z4+4 .4618987048E-7) *Z4-8. 42694918892E-6) *Z4+4.42886829G095E-6) * 


Z4-4,226299352171G1E-3) *24+2 .577496871760433E~-2) * 
Z4+4 .2359946482277074E-1) *Z4+1EQ) 

RETURN 

END 


PLE 
PLE 
PLE 
PLE 
PLE 
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COMPLEX FUNCTION PLEM1(Z) 


FIRST DERIVATIVE OF WEIERSTRASS: P-FUNCTION IN THE 
LEMNISCATIC CASE FOR COMPLEX ARGUMENT 
WITH UNIT PERIOD PARALLELOGRAM 


COMPLEX Z, Z1, 23, Z4 
REAL ZR, ZI 
INTEGER M, N 


REDUCTION TO FUNDAMENTAL PARALLELOGRAM 


ZR = REAL(Z) + @.5E@ 

ZI = AIMAG(Z) + @.5E@ 

M = INT(ZR) 

N = INT(ZI) 

IF (ZR.LT.@E@) M=M-1 
IF (ZI.LT.@EO) N=N-1 


Zl = Z = FLOAT(M) - (@E@,1E@)*FLOAT(N) 


IF Zl=@ THEN Z COINCIDES WITH A LATTICE POINT. 
SINCE P: HAS POLES AT THE LATTICE POINTS, 


A DIVISION ERROR WILL OCCUR 
Z3 = Z1*Z1*Z1 
Z4 = Z3*Z1 


PLEM1 = (((1E1*Z4+9E1) *Z4+3E1) *Z4—2E@) / (Z1* (1EQ-Z4) )**3 + 


PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 


Z1*((((( CCC C(-3.. 9046 302E-9*Z4-1. 061487137E-8) *Z4+5. 957 3043092E-7) PLE 


*7.4-2.482518130524E-5) *Z441. 4557266595 395E-4)* 
Z4+4 ,56633655643206E-3) *Z44+6. 224782572111135E-2)* 
Z4+1.038527937794269E-2) *Z4+1. 19804620862637942EO) * 
Z4+6 .42791439683811718E@) *Z4—5.09272798707661477EQ) / 
(CC CCC CCC (4. 726888E-11*2Z4-3.0667983E-9) *Z44+1. 6087596089E-7)* 
Z4-8.060683451E-8) *Z4+1.184299251664E-5) *Z4—2 . 309672336154 7E-4)* 
Z4—2.90730903142055E-3) *Z4+1. 338392411135511F-2)* 
Z4+2 . 3098639 320621426E-1) *Z44+8. 4719880964554148E-1) *Z4+4+1EO) 
RETURN 
END 


COMPLEX Z, PEQ, PEQ1, CR, CI, P, Pl 
REAL W2, SQ3, FP, FP1, EPS, EPS1, A, C 


PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 
PLE 


MAN 
MAN 
MAN 


KRREKKEREKRERERRRERKRERRERRERERERRRRRKERERERRRRERERERRRRRERRRRREREKEMAN 


MAN 


THE PROGRAMS FOR WEIERSTRASS: P-FUNCTION AND iTS DERIVATIVE IN THEMAN 


EQUIANHARMONIC CASE ARE TESTED FOR THE ARGUMENT VALUES 
Z = 0.25, 0.5, 0.5 + O.5/SQRT(3)*I, 6.25 + @.25/SQRT(3)*I 

AND 2.5 - 47/6*SQRT(3)4*1 

(SEE M. ABRAMOWITZ AND I. A. STEGUN& HANDBOOK OF MATHEMATICAL 
FUNCTIONS, 18.13. FOR CORRESPONDING FUNCTION VALUES) 

THE DRIVER PROGRAM PRINTS THE MAXIMAL RELATIVE ERRORS OF P AND P: 


BRREEKREERKERKERERERRRRRRRERRERRERERRRRERRERERRREERRRRERERERERKEREEREEKMAN 


EVALUATION OF CONSTANTS 


SSS SSS SS SS SSS SS SS SS Ss 


SQ3 = SQRT(3.0) 

CR = (1.6,¢.0) 

CI = (@.0,1.9) 

C = 4.0**(-1.6/3.0) 

W2 = 1.52995403765719287491319417231 
W2 = 2.@*W2 

FP = 1.0/(W2*W2) 

FP1 = FP/W2 


RKRKRKEKK KR KEK KR 


(9.25,0.0) 

PEQ(Z) 

Pl = PEQ1(Z) 

EPS = CABS (P*FP-C*(1.@+SQ3)*CR) /CABS (P) 

EPS1 = CABS (P1*FP1+3.0**@. 75*SQRT (2.0+5Q3) *CR) /CABS (P1) 


MAN 
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Cc 
Cc kKkKK Kk KK Kk KE 
C 
Z = (0.5,0.9) 
P = PEQ(Z) 
Pl = PEQI(Z) 
A = CABS (P*FP-C*CR) /CABS (P) 
IF (A.GT.EPS) EPS = A 
A = CABS(P1*FP1) 
IF (A.GT.EPS1) EPS1 =A 
Cc 
Cc kk KK Kk KK Kk KK 
C 
Z = O.5*CR + 0.5/SQ3*CI 
P = PEQ(Z) 
Pl = PEQ1(Z) 
A = CABS (P*FP) 
IF (A.GT.EPS) EPS = A 
A = CABS (P1*FP1-CI) /CABS (P1) 
IF (A.GT.EPS1) EPS1 =A 
C 
Cc KRAR KK KKK KK 
Cc 
Z = Z*O.5 
P = PEQ(Z) 
Pl = PEQI(Z) 
A = CABS (P*FP+2.0** (1.0/3.0) *0. 5* (-CR+SQ3*CI) ) /CABS (P) 
IF (A.GT.EPS) EPS = A 
A = CABS(P1*FP1-(.6, 3.0) ) /CABS (P1) 
IF (A.GT.EPS1) EPS1 =A 
c 
C kRKK KKK KKK K 
c 
Z = 2.5*CR — 47.0*SQ3/6.@*CI 
Cc 
Cc THIS Z IS FOR TESTING THE REDUCTION TO FUNDAMENTAL PARALLELOGRAM. 
Cc BECAUSE OF THIS REDUCTION, THE ERROR MIGHT BE AN ORDER OF 
Cc MAGNITUDE GREATER THAN THE BOUND GIVEN IN THE TEXT 
Cc 
P = PEQ(Z) 
Pl = PEQI(Z) 
A = CABS (P*FP) 
IF (A.GT.EPS) EPS = A 
A = CABS(P1*FP1-CI) /CABS (P1) 
IF (A.GT.EPS1) EPS1 = A 
C 
Cc kKkKRK KKK Kk KKK 
Cc KKAR Kk KKK KR RK 
Cc 


WRITE (6,99999) 
WRITE (6,99998) EPS 
WRITE (6,99997) EPS1 
STOP 
99999 FORMAT (51H1 MAXIMAL RELATIVE ERROR FOR WEIERSTRASS P-FUNCTI, 
* 2HON/52H IN THE EQUIANHARMONIC CASE AT FIVE SAMPLE POINTS/4X, 
* 5@(1H=)) 
99998 FORMAT (////25H RELATIVE ERROR FOR P=, 5X, E1@.3) 
99997 FORMAT (//26H RELATIVE ERROR FOR Pl=, 4X, E1@.3) 
END 
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ALGORITHM 550 
Solid Polyhedron Measures [Z] 


A.M. MESSNER 

General Dynamics 

and 

G.Q. TAYLOR 

1.T.T. Federal Electric Corporation 


Key Words and Phrases: polyhedron, graphics, numerical integration 
CR Categories: 3.2, 5.16, 8.2 
Language: Fortran 


DESCRIPTION 


Surface area, centroid, volume, weight, moments, and products of inertia are 
computed by numerical integration over the bounding surfaces of solid polyhedra. 
This routine operates directly on geometric definitions consisting of vertex 
coordinates and face lists, in a format similar to the format employed in graphics 
and in plotting computer programs [1, 3, 5]. Integration is performed through a 
quadrature rule that is exact for the equations involved. 


METHOD 


The several equations, eqs. (1) through (10), to be integrated over the surface of 
the polyhedra were derived from volume integral forms through application of 
the Gauss divergence theorem. 


mass = 5 {| [xnx + yn, + znz] dS = M (1) 
pee 2 

CG. aM i [x“nx] dS (2) 

CG, = at | [y’ny] dS (3) 
{ = ie 2 

CG. WY] {J [z*n.] dS (4) 

Tex = : i i [y*ny + 2°nz] dS (5) 
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Ly = | i (2°nz + x°n,] dS (6) 
I. = i i [x°ne + y°n] dS - og 
Py = + | i [yx’nx] dS (8) 
Py: => | | [zy’n,] dS (9) 
Pix = + i | [xz’n.] dS (10) 


where {f dS implies integration over the entire bounding surface; x, y, and z are 
right-hand Cartesian coordinates; n., ny, and n, are components of the outward 
directed normal vector of unit length; p is density per cubic unit; CG,, CG,, and 
CG, are coordinates of the centroid; [,,, [,y, and Iz, are moments of inertia about 
the x, y, and z axes; P,,, P,z, and P., are products of inertia with respect to the 
subscripted axes with sign convention as shown. 

Consider, for example, the moment of inertia about the x axis (as given in 


[2]): 
Les = | | | o(y? + 22) dV. 


We define a specific vector function F as follows: 
oP ae 3 
F= 3 {yj + 2°k} 


where j and k are unit vectors in the coordinate directions y and z, respectively. 
The divergence of F is 


3 3 
div F = 2 {900 4 A 


= 24 32) 
ay =| p(y + 2°) 


Gauss’s divergence theorem states 


[[ | awrav- || pnas 
[[[oor+erav= | [ So? my + 2mm as 


which verifies that the surface integral form, eq. (5), is the equivalent of the 
volume representation. 

Computation of the surface integrals is done through a quadrature rule applied 
to the triangular elements of the surface polygons. We employ a four-point rule, 
eq. (11), that is exact for polynomials up to degree three. This rule, a minimum- 
point exact rule for our purpose [6] converts the continuous integral into a sum 
of four discrete values evaluated at specific points in each triangle. Point locations 
and associated weights are as follows: 


yielding 


I] f dA = area[f(pi)wi + f(p2)w2 + f(ps)ws + f( ps)wa] (11) 
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where p; is the centroid of the triangle, w; = —27/48, we = w3 = ws = 25/48. po, 
Ps, and p, are located along lines from the centroid to the triangle vertices such 
that the distance to these points is equal to 40 percent of the distance from the 
centroid to the respective vertex. 

Each surface polygon is treated as a group of triangles that are constructed as 
follows: Vertices 1, 2, and 3 form the first triangle, vertices 1, 3, and 4, form the 
second triangle, etc., with 1, m — 1, and n being the last triangle in a perimeter of 
n vertices. Normal vectors are computed for each triangle to ensure that concave 
polygons yield negative contributions when the perimeter reverses direction 
relative to the initial vertex. Contributions to mass, CG, products of inertia, and 
moments of inertia are accumulated in sequence to cascade the calculations and 
thereby reduce arithmetic operations. Global factors such as density are applied 
after all faces have been processed. Properties are finally shifted to parallel axes 
through the computed centroid. In this form, standard methods can be employed 
to yield values about arbitrary axes or to solve for principal values. 


DESCRIPTION OF THE ALGORITHM 


The algorithm is presented as two subroutines: PROPS and SRFINT, which are 
structured to operate on polyhedrons defined as a series of vertices and associated 
connectivity (faces) lists. Specific details of an appropriate data structure are 
illustrated by the example shown in Figure 1 and a driver program based on this 
format is included. Vertices are numbered, and defined in terms of their compo- 
nents in a right-hand rectangular Cartesian coordinate system. Faces are also 
numbered, and listed as a series of vertices in the order encountered while 
traversing the perimeters. Perimeters are traversed in a direction that is consistent 
with an inward surface vector definition. This ordering convention can be envi- 
sioned as follows: If one were to stand on the face with the left foot on the edge 
of the face and the right foot on the interior of the face and then traverse forward 
around the perimeter, vertices would be encountered in the required order. 
Perimeter lists are closed (the first vertex number is repeated at the end of the 
list) and each face consists of one or more perimeters. These aspects are illustrated 
by the example shown in Figure 1. Large faces are accommodated for in the driver 
program by continuing perimeter lists on subsequent cards using all data fields 
(including the first field normally used for the face number). A repeat of the 
initial vertex designates the end of the list. 

Errors in the input data can occur, and are often difficult to detect unless 
systematic tests of data integrity are adopted. Geometric tests can be made to 
insure that the polyhedron is connected and has planar faces. These tests will 
vary with the application; nonplanar faces, for example, may be permitted in a 
mechanically deformed solid, relying on the triangulation process within the 
algorithm to enforce planarity. In our experience the most useful test has been a 
connectivity evaluation that sorts all edges and proceeds to match each edge 
against its reciprocal (same edge lists in the opposite order on another face). This 
test is easily accomplished while generating plots [3]. If each edge has one and 
only one reciprocal in the face lists there is reasonable assurance that the 
connectivity is valid. Another data error encountered in extensive polygon defi- 
nitions is the omission of coordinates of one or more vertices. This error will 
usually result in coordinate values of zero, which can be tested, and appropriate 
cautionary messages printed out to aid the correction process. Large data sets 
may require graphic-generation techniques such as the use of digitizers or inter- 
active entry devices. In most instances computer plots should be obtained as a 
further data check. Our experience is primarily with computations relating to 
designed components which are defined by engineering drawings. These drawings 
are reduced to appropriate card formats through digitizer equipment interfaced 
to a keypunch machine. Perspective plots (Figures 2 and 3) generated through a 
derivative of the Loutrel Algorithm [3] have been valuable guides to data 
integrity. 
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O vertex numbers 


0) face numbers 


! 2 3 
123466789012 3456789012345678901234567890 a 
MASS OF CUBE WITH CUTOUT _ TITLE! (must start with’mass") 7 ba 


max 
- eo -——~{ face 
(6) (10) 6 number 
; 1.0 Ye) a0 \ 
2 i) 0.0 1.0 density 
3 LO 1.0 1.0 
o| * 1.0 1.0 0.0 
2 5 0.0 e | a0 © Lo 
ZS] 6 8 | 00 2] 0 2} to 
El 7 S | oo =] 10 = | 00 
Zz} a 7s J 00 So } 00 Ss | 00 
x] 9 8 1.0 S | O26 S \ 0.28 
=| 10 8 | 10 & | 0.28 3 | O78 
e| ou | (bO > | 0.75 0.75 
12 1.0 O75 “ | a2 
13 ; 0.25 
4 0.75 
6 0.75 
6 0.25 
\ 2 
' 12 
o 2 6 
s 2 14 
—| 3 : 
pub rine 3 | 4 3 face lists 
° 6 2 (closed perimeters) 
=| 7 10 
8 3 
9 
10 
END 
Fig.1. Input definitions. 
TESTS 


This algorithm has been in use for several years and checked for simple geometries 
such as cubes and prisms as well as for complex configurations. Comparisons have 
also been made with fabricated components where computed values were com- 
pared with measured quantities of finished parts. Accuracies in all instances were 
within manufacturing tolerances. Computational errors arise from roundoff op- 
erations within the computer and can be minimized by multiple-precision arith- 
metic or through specific protection algorithms [4]. 

Several specific test problems are presented to illustrate the accuracies obtain- 
able in single and double precision with the IBM 370 equipment. The first 
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Table I. Solutions Using Single and Double Precision with IBM 370 Computer 


Single-Precision Solution to Test Problem 1 (100.0-inch cube with cutout 


0.01-inch wall.) 


Density 
Area 


Volume 


Weight 


CG 
coordinates 

Moment 
from origin 
from CG 


Product moment 


from origin 
from CG 


2.00000 
79999.8750 


(79999.9992)* 


399.7500 
(399.96)* 

799.50000 
(799.92)* 


50.031 
(50.0)* 
6589440.00 
2596525.00 
(2665866.666)* 


xy 


1992960.00 
—9891.000 
(0.0)° 


Axes 


50.071 
(50.0)* 
5943488.00 
1953777.00 
(1999533.36)* 


Axes 
yz 
1988096.00 


—8345.000 
(0.0)* 


49.871 
(50.0)* 
5953024.00 
1947323.00 

(1999533.36)* 


ax 


1986816.00 
—8029.000 
(0.0)* 


Double-Precision Solution to Test Problem 1 (100.0-inch cube with cutout 


0.01-inch wall.) 


Density 
Area 

Volume 
Weight 


CG 
coordinates 

Moment 
from origin 
from CG 


Product moment. 


from origin 
from CG 


2.00000 
79999.99920 
399.95994 
799.91988 


50.00000 


6665464.73061 
2665866.08647 


xy 


1999799.32206 


—0.000000 


Axes 


y 


50.00000 


5999131.51563 
1999532.87149 


Axes 


yz 


1999799.32206 
—0.00001 


* True values shown below analogous computer results, 


50.00000 


5999131.51563 
1999532.87149 


ax 


1999799.32206 
—0.00001 
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Fig. 3. Test Problem 3 Mobius and sectioned Mobius. 


problem consists of a 100.0-inch cube, with cutout as in Figure 1. Cutout 
dimensions are such that the remaining wall thickness is 0.01 inch. Computations 
involve powers of coordinates which differ by the wall thickness; therefore, as the 
wall gets sufficiently thin, accuracy deteriorates. The complete single- and double- 
precision solution to this problem is presented in Table I. It can be seen that 
inaccuracies are evident in the single-precision solution, although even this 
problem, which is somewhat extreme for practical purposes, did not produce 
catastrophic errors. A second test has been constructed to indicate the accuracies 
related to geometries containing numerous faces with diverse orientations. This 
second test relates to the symmetry of results obtained for a generated configu- 
ration depicted in Figure 2. It was constructed by displacing an 8-inch square 
cross section normal to its plane in such a manner that its center traversed a 10- 
inch-radius circle while rotating 180 degrees in its plane during one traverse of 
the circle. The circle has its center at the origin ancl lies in the x-y plane. Single- 
and double-precision solutions are presented in Table Il. Moments about x and 
y should be equal and the centroid and products of inertia components should be 
zero. It is of interest to note that the volume is some 2 percent smaller than would 
be obtained with a continuous solid generated in this manner. This discrepancy 
arises from the inscribing character of the polyhedron construction and would 
decrease as the number of faces increase. A final test is presented in Figure 3. 
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Table II. Computer Solutions to Example Problem 2 


Single-Precision Solution to Problem 2 


Density 
Area 

Volume 
Weight 


CG 
coordinates 

Moment 
from origin 
from CG 


Product moment 


from origin 
from CG 


2.00000 
2058.57715 
3941.82104 
7883.64062 


0.000 


497116.062 
497116.062 


xy 


—23.484 
—23.484 


Double-Precision Solution to Problem 2 


Density 
Area 

Volume 
Weight 


CG 
coordinates 

Moment 
from origin 
from CG 


Product moment 


from origin 


from CG 


2.00000 
2058.63206 
3942.03508 
7884.07016 


—0.00000 


497209.13864 
497209.13864 


xy 


—0.00155 
—0.00155 


Axes 


y 


—0.000 


497103.187 
497103.187 


Axes 


yz 


—0.063 
—0.063 


Axes 


y 


0.00000 


497209.12703 
497209.12703 


Axes 


ye 


0.00022 
0.00022 


0.000 


911423.062 
911423.062 


2x 


—0.033 
—0.033 


0.00000 


911523.19783 
911523.19783 


aX 


—0.00010 
—0.00010 
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Table III 
Solution to Complete Solid Test Problem 3 
Density 2.00000 
Area 630.20361 
Volume 241.44048 
Weight 482.88086 
Axes 
x y z 
CG 
coordinates 0.03247 --0.00031 0.00000 
Moment 
from origin 24961.5117 24960.8477 49240.2383 
from CG 24961.5117 24960.3359 49239.7266 
Axes 
xy yz ZX 
Product moment 
from origin —0.21539 —309.58984 0.00619 
from CG —0.21049 —31)9.58984 0.00618 
Solution to Sectioned Solid Test Problem 3 
Density 2.00000 
Area 424.16016 
Volume 120.71504 
Weight 241.43008 
Axes 
x y z 
CG 
coordinates 0.03247 --0.75071 0.67662 
Moment 
from origin 12478.8516 12479.5312 24617.2148 
from CG 12232.2578 12368.7422 24480.8984 
Axes 
xy ye zx 
Product moment 
from origin —375.08545 —154.91779 —445.60889 
from CG —369.20068 —32.28427 —450.91260 


This third test problem is similar in configuration to the second except that the 
cross section is now a 1- by 4-inch rectangle (finite thickness Mobius strip). A 
plane through the generating circle of this configuration bisects it identically. 
Solutions in single precision are presented to the complete and the sectioned solid 
in Table III where it can be seen that the volume, weight, moments about the 
axes, and the y-z product moment are halved as required. The x coordinate of 
the centroid is not zero due to the discretization errors associated with the 
geometry construction. 
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ALGORITHM 
PURPOSE 
TO CALCULATE MASS PROPERTIES OF GENERAL THREE 
DIMENSIONAL SOLIDS. 


DESCRIPTION 


TRIANGULATED, AND A FOUR POINT GAUSSIAN QUADRATURE OVER 


THE TRIANGLES IS USED IN CALCULATING SURFACE AREA, 
VOLUME, AND MASS PROPERTIES. 


COMMON MAXS , MAXV, 
‘ AREA, WEIGHT, VOL, DENS, 

CG(3) ,10(3) ,ICG(3) ,PR(3) ,PRCG(3), 
. ERROR, NERR, 
‘ HED (80) , IN,OT,KT, 
; N8,MAXKV 
LOGICAL ERROR 
INTEGER OT 
INTEGER TITLE,END,HED 
DIMENSION A(160060) ,KA(6000) 
REAL 10,1CG 
DATA TITLE,END /1HM, 1HE/ 


THE FOLLOWING TWO STATEMENTS SET STORAGE LIMITS. 
DIMENSION A(10¢00@) ,KA(6000) 
MAXKV=60600 
IN=5 
OT=6 


aaa 


TITLE AND CONTROL CARDS ARE READ FOR CURRENT CASE. 


aaa 


1 READ (IN,4) HED 
IF (HED(1) .EQ. TITLE) GO TO 2 
IF (HED(1) .NE. END ) GO TO 1 


C END OF JOB 
STOP 
C 
C ARRAY POINTERS ARE DETERMINED. 
C CORRESPONDENCE 
C POINTER N1 N2 N3 N4 N5 N6 N7 N8 
C ARRAY VX VY VZ KFA AX AY AZ KV 
Cc 


2 ERROR=.FALSE. 
READ (IN,7) MAXV,MAXS, DENS 
WRITE (OT,6) HED,MAXV,MAXS, DENS 


N1=1 
N2=N1+MAXV 
N3=N2+MAXV 
N4=1 
N5=N3+MAXV 
N6=N5+MAXS 
N7=N6+MAXS 
N8=N4+MAXS 
Cc 
C VERTEX COORDINATES AND FACE LISTS ARE INPUT 
Cc 
C CALL FACES ( KV, KFA, VX, VY, VZ ) 
CALL FACES (KA(N8) ,KA(N4) ,A(N1) ,A(N2) ,A(N3) ) 
IF (ERROR) GO TO 3 
Cc 
C MASS PROPERTIES ARE CALCULATED 
C 
Cc CALL PROPS ( KV, KFA, AX, AY, AZ, 
Cc VX, VY, Vz ) 


“CALL PROPS (KA(N8) ,KA(N4) ,A(NS) ,A(N6) ,A(N7), 
; A(N1) ,A(N2) ,A(N3) ) 
IF (ERROR) GO TO 3 


Cc 
C AND PRINTED OUT. 
C 
CALL MASSPR 
GO TO 1 
Cc 


Cc 
C 
C 
C 
C 
C THE SOLID IS DESCRIBED BY A SET OF SURFACES WHICH ARE 
C 
Cc 
C 
C 
C 
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C 
C 


aaana OOAOAMIAAAaRAAANAAAA AMAA SG ana 


aa 


aaa 


ERROR ENCOUNTERED. ERROR CODE PRINTED OUT. 


3 WRITE (OT,5) HED,NERR 
GO TO 1 


FORMAT STATEMENTS 


4 FORMAT (8@A1) 
5 FORMAT (1H1,8@A1///27H ERROR ENCOUNTERED, CODE = ,11) 
6 FORMAT (1H1,8@Al/// 7H MAXV =,13/ 
z 7H MAXS =,13/ 
7H DENS =,F1@.3) 


7 FORMAT (215,F10.10) 
END 
SUBROUTINE FACES (KF,KFA,VX,VY,VZ) 


PURPOSE 
TO READ VERTEX COORDINATES AND FACE LIST DATA AND SETUP 
DATA IN GLOBAL STORAGE. 


DESCRIPTION 
A FACE BOUNDARY IS MADE UP OF A CLOSED SET OF NUMBERED 
POINTS (VERTICES) CONNECTED BY STRAIGHT LINES. 
A FACE LIST, ENUMERATING THE VERTICES OF THE FACE TAKEN 
IN SUCCESSION AROUND THE BOUNDARY, IS THE DATA 
REPRESENTATION OF THE FACE. 
A SURFACE OF THE SOLID MAY BE COMPOSED OF MORE THAN ONE 
FACE, AN INITIAL FACE AND SECONDARY FACE(S). THEY ARE 
LINKED TOGETHER IN STORAGE BY A POINTER FROM ONE FACE 
TO ANOTHER. 
THERE ARE NO PRACTICAL RESTRICTIONS ON THE NUMBER OF 
VERTICES PER FACE. THE MAXIMUM NUMBER OF SURFACES IS 
CONTROLLED BY THE EXTENT OF AVAILABLE COMPUTER STORAGE 
AND IS ALSO DEPENDENT ON THE TOTAL NUMBER OF VERTICES. 


COMMON MAXS ,MAXV, 

; AREA, WEIGHT, VOL, DENS, 

CG(3) ,10(3) , ICG(3) ,PR(3) ,PRCG(3), 
ERROR, NERR, 

HED (8@) ,IN,OT,KT, 

; N8 ,MAXKV 

INTEGER HED 
DIMENSION KF(1) ,KFA(1),VX(1) , VY (1) ,VZ(1) 
LOGICAL ERROR 

INTEGER OT 


VERTEX COORDINATES ARE READ IN AND PRINTED. 


KT=5@ 

1 READ (IN,14) IEND,NV,X,Y,Z 
CALL COORDS (NV,X,Y,Z) 
IF (NV .LE. @ .OR. NV .GT. MAXV) GO TO 9 
VX (NV) =X 
VY (NV)=Y 
VZ(NV)=Z 
IF (IEND .EQ. 6) GO TO 1 


FACE POINTER ARRAY IS CLEARED. 


DO 2 I=1,MAXS 
2 KFA(1)=0 
KT=50@ 
M1l=1 
3 M2=M1+2 
M3=M1+16 


SURFACE ELEMENT DEFINITIONS ARE INPUT AND STORED. 


READ (IN,15) IEND,KF(M1) , (KF(M) ,M=M2,M3) 
NF=KF (M1) 
K=KFA (NF) 
KF (M1+1)=@ 
IF (K .NE. 0) GO TO 4 


C INITIAL (OR ONLY) FACE DEFINITION. 


KFA (NF)=M1 


750 
760 
770 
780 
790 
800 
816 
820 
830 
840 
85¢ 
860 
870 
880 
890 
960 
91¢ 
92¢ 
930 
949 
95¢ 
960 
9706 
980 
990 
1AGO 
161¢ 
10626 
1630 
10640 
1650 
166% 
1070 
1680 
1690 
11066 
1116 
1120 
113¢ 
114¢ 
115¢ 
1169 
1170 
1180 
1196 
1260 
1216 
1220 
123¢ 
1249 
125@ 
1260 
1270 
1280 
1290 
13060 
1310 
1320 
1330 
134@ 
1350 
1360 
137¢ 
1386 
1390 
1460 
1410 
1426 
1430 
1446 
1450 
1466 
1470 
1480 
1490 
1560 
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GO TO 5 
C SECONDARY FACE POINTER IS STORED. 
4  KK=K 
=KF (KK+1) 
IF (K .NE. $) GO TO 4 
K=KF (KK+1) 
IF (K .NE. §) GO TO 4 
KF (KK+1)=M1 


aa 


CHECK IS MADE TO SEE IF DEFINITION IS COMPLETE. 


5 KV1=KF (M2) 
M2=M2+1 
6 DO 7 T=M2,M3 
KV=KF (I) 
IF (KV .EQ. KV1) GO TO 8 
IF (KV .LE. @ .OR. KV .GT. MAXV) GO TO 8 
7 CONTINUE 


DEFINITION CONTINUED. 


aan 


M2=M3+1 
M3=M3+16 
READ (IN,15) IEND, (KF(M) ,M=M2,M3) 
GO TO 6 


aQaaa 


8 M2=M1+2 
M3=1 
CALL FACVRT(NF,KF,M2,M3) 
IF (KV .LE. @ .OR. KV .GT. MAXV) GO TO 11 
M1=I+1 
IF (M1+N8 .GT. MAXKV) GO TO 12 
IF (IEND .EQ. @) GO TO 3 
RETURN 


ERROR RETURN. 


aaana 


VERTEX NUMBER OUT OF RANGE 
9 NERR=1 
GO TO 13 
C INPUT FACE NUMBER OUT OF RANGE 
16 NERR=2 
GO TO 13 
C ILLEGAL VERTEX NUMBER. 
11 NERR=3 
GO TO 13 
C STORAGE EXCEEDED. 
12 NERR=4 
13 ERROR=.TRUE. 
RETURN 


FORMAT STATEMENTS 


aaa 


14 FORMAT (11,14,5X, 3F10.9) 
15 FORMAT (11,14,1515) 
END 
SUBROUTINE COORDS (NV,X,Y,Z) 


PURPOSE 
PRINTS VERTEX COORDINATES, WITH PAGE CONTROL. 


aAaAaaAaAA 


COMMON MAXS , MAXV, 

AREA, WEIGHT, VOL,DENS, 

CG(3) ,10(3) ,1CG(3) ,PR(3) ,PRCG(3), 
ERROR, NERR, 

; HED(8@) , IN,OT,KT 

INTEGER OT 
INTEGER HED 


IF (KT .LT. 50) GO TO 1 
C TITLE AND HEADING. 
WRITE (OT,2) HED 


GETTING SET FOR NEXT SURFACE, PRINT CURRENT SET OF VERTICES. 


1510 
1520 
1530 
1540 
1550 
1560 
1576 
1580 
1590 
1600 
1610 
1626 
1636 
164@ 
1650 
1660 
1670 
1680 
1690 
1760 
1710 
1720 
1730 
1740 
1756 
1760 
1770 
1780 
1796 
1800 
1810 
1826 
1830 
1840 
18506 
186¢ 
1870 
1880 
1896 
1900 
1916 
1920 
1930 
1940 
1950 
1960 
1970 
1980 
1990 
20600 
2016 
26206 
2630 
2046 
2050 
2060 
2070 


. 2680 


2090 
21066 
2110 
2120 
2130 
2140 
215¢ 
2160 
2179 
2180 
2190 
2200 
2210 
2220 
2230 
2246 
2250 
2260 
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KT=@ 
WRITE (OT, 3) 
C VERTEX COORDINATES 
1 KT=KT+1 
WRITE (OT,4) NV,X,Y,Z 
RETURN 
Cc 
C FORMAT STATEMENTS. 


2 FORMAT (1H1,8@A1///) 
3 FORMAT (7H VERTEX, 9X, 1HX,12X, 1HY,12X,1HZ /) 
4 FORMAT (16, 3F13.2) 

END 

SUBROUTINE FACVRT (NF,KV,M2,M3) 


PURPOSE 
PRINT FACE VERTICES, WITH PAGE CONTROL. 


aagaAaan 


COMMON MAXS ,MAXV, 
AREA, WEIGHT, VOL, DENS, 
CG(3) ,10(3) ,1CG(3) ,PR(3) , PRCG(3), 
ERROR, NERR, 

j HED (80) , IN, OT,KT 

DIMENSION KV(1) 

INTEGER HED 

INTEGER OT 


IF (KT .LT. 56 ) GO TO 1 
C TITLE AND HEADING. 

WRITE (OT,2) HED 

WRITE (OT, 3) 

KT=¢@ 


FACE VERTICES. 


aaa 


1 KT=KT+1 
M4=MIN@ (M3 ,M2+9) 
WRITE (OT,4) NF, (KV(M) ,M=M2,M4) 
IF (M4 .EQ. M3) RETURN 
M4=M2+16 
WRITE (OT,5) (KV(M) ,M=M4 M3) 
RETURN 


ana 


FORMAT STATEMENTS. 


2 FORMAT (1H1,8@A1///) 
3 FORMAT (25H FACE VERTICES ... /) 
4 FORMAT (/15,5H -  ,1@15) 
5 FORMAT (10X,1@15) 
END 
SUBROUTINE MASSPR 
C 
C PURPOSE 
PRINT MASS PROPERTIES OF A SOLID. 


DESCRIPTION 
PRINTS 
DENSITY, AREA, VOLUME, WEIGHT 
CENTER OF GRAVITY COORDINATES 
COORDINATES OF MASS MOMENTS OF INERTIA W/R TO ORIGIN 
COORDINATES OF MASS MOMENTS OF INERTIA W/R TO CG 
COORDINATES OF PROD MOMENTS OF INERTIA W/R TO ORIGIN 
COORDINATES OF PROD MOMENTS OF INERTIA W/R TO CG 


aAanrNaaaanwanand 


COMMON MAXS ,MAXV, 
AREA,WEIGHT, VOL, DENS, 

CG(3) ,10(3) ,ICG(3) ,PR(3) ,PRCG(3), 
ERROR, NERR, 

: HED (8@) , IN, OT, KT 

INTEGER HED 
INTEGER OT 

REAL 10,ICG 


2276 
2280 
2290 
2300 
2316 
2320 
233 
2346 
2350 
2360 
2370 
2380 
2390 
24006 
2416 
2420 
2430 
2446 
2456 
2466 
2470 
2486 
2490 
2500 
2510 
2520 
2530 
2546 
2550 
2560 
2570 
2580 
2596 
2600 
2610 
2620 
2630 
2640 
2650 
2660 
2676 
2680 
2690 
2700 
2710 
2720 
2730 
2746 
2750 
2766 
2770 
2780 
2796 
2800 
2810 
2820 
2830 
2846 
2850 
2860 
2870 
2880 
2890 
2906 
2916 
2920 
2936 
2940 
2950 
2960 
2970 
2980 
2990 
3000 
3610 
3020 
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C 


WRITE (OT,1) HED 

WRITE (OT,2) DENS,AREA, VOL, WEIGHT 
WRITE (OT, 3) 

WRITE (OT,4) CG 

WRITE (OT,5) IO 

WRITE (OT,6) ICG 

WRITE (OT,8) 

WRITE (OT,7) PR 

WRITE (OT,6) PRCG 

RETURN 


C FORMAT STATEMENTS. 


Cc 


1 FORMAT (1H1,80A1///) 

2 FORMAT (1@X, 7HDENSITY , 9X, 4HAREA, 10X, 6HVOLUME, 9X, 
: 6HWEIGHT//2X,4F15.5///) 

3 FORMAT (13X, 4HAXES, 8X, 6HX-COMP , 9X, 6HY-COMP , 9X, 


; 6HZ-COMP /) 

4 FORMAT (1X,16H CG COORD, 3F15.5/) 

5 FORMAT (1X, 16HMOMENT COORD, 3F15.5 ) 

6 FORMAT (1X,16H CG, 3F15.5/) 

7 FORMAT (1X,16HPROD MOM COORD, 3F15.5) 

8 FORMAT (//13X, 4HAXES, 8X, 7HXY-COMP, 8X, 7HYZ-COMP, 8X, 
. 7HZX-COMP /) 
END 


C SOLID POLYHEDRON MEASURES 


MANANAAANDAARAADAANAAAANAANDAQAAANAAANRAAAAAAAQAARAAARANDNANANMAAANARARAAAAAN 


PURPOSE 


TO CALCULATE MASS PROPERTIES OF THREE DIMENSIONAL SOLIDS 
BY A SURFACE INTEGRATION TECHNIQUE USING FOUR-POINT 
GUASSTAN QUADRATURE OVER TRIANGLES. 


SOLID 


DEFINED BY A SET OF SURFACES, WHERE EACH SURFACE IS 
COMPOSED OF ONE OR MORE COPLANAR CLOSED POLYGONAL 
PATCHES CALLED FACES. DISCONNECTED FACES AND FACES WITH 
ONE OR MORE HOLES IN THEM MAY BE USED, IF NECESSARY, 

TO REPRESENT THE SOLID. 


FACE 


A FACE IS REPRESENTED BY THE SET OF VERTEX POINTS OF THE 
POLYGONAL SURFACE PATCH, ORDERED BY STARTING WITH AN 
ARBITRARY VERTEX, AND PROCEEDING POINT BY POINT AROUND 
THE BOUNDARY UNTIL THE FIRST POINT IS REACHED. 


FACE LIST 


THE LIST OF THE SET OF VERTEX NUMBERS, ORDERED AS ABOVE 
FOR A FACE, IS CALLED A FACE LIST, WHICH IS THE DATA 
REPRESENTATION OF A FACE. A FACE LIST HAS THE FORM 
NSF,NA,NB,NC,...,NI,...,NA 
WHERE NSF IS THE SURFACE NUMBER AND NA,NB,NC,NI ARE 
VERTEX NUMBERS. NOTE THAT THE FACE LIST IS A CLOSED 
LIST, STARTING AND ENDING WITH THE FIRST POINT SELECTED. 
FOR ANY SURFACE WITH ONE OR MORE HOLES IN 
IT, ANY INTERIOR BOUNDARY (HOLE) IS REPRESENTED BY A 
FACE LIST WITH VERTICES ENUMERATED IN A SEQUENCE 
OPPOSITE TO THAT GIVEN FOR AN EXTERIOR BOUNDARY. 


INITIAL, SECONDARY FACE LISTS 


WHEN MULTIPLE FACE LISTS ARE NEEDED TO DEFINE A SURFACE, 
(IE, A SURFACE WITH A HOLE OR ONE WITH DISCONNECTED BUT 
COPLANAR PARTS), THE FIRST LIST TO APPEAR IN THE DATA IS 
CALLED THE INITIAL FACE LIST, AND ANY OTHER IS CALLED A 
SECONDARY FACE LIST. THESE LISTS WILL HAVE A COMMON 
SURFACE NUMBER AND WILL BE LINKED TOGETHER IN STORAGE BY 
THE DATA ENTRY ROUTINE. 


GLOBAL DATA ARRAYS 


FACE LIST DATA IS STORED COMPACTLY IN A LARGE OPEN-ENDED 
DATA ARRAY KV. 

A LINKAGE ARRAY, KFA, SETUP BY THE DATA ENTRY ROUTINE, 
CONTAINS POINTERS TO THE INITIAL FACE LIST (IN KV) FOR 
EACH SURFACE, ORDERED BY SURFACE NUMBER. IF Ll, L2, L3 
ARE LOCATIONS IN KV OF FACE LISTS FOR SURFACES 1, 2, 3, 


3630 
3040 
3050 
3960 
3070 
3080 
3990 
3100 
3110 
3120 
313¢ 
3140 
315 
3160 
31706 
3180 
3190 
32006 
3210 
3220 
3230 
3240 
325¢ 
3260 
3270 
3286 
3290 
3300 
3310 
3320 
3330 
3340 
3350 
3360 
3370 
3380 
3390 
3400 
3410 
3426 
3430 
3440 
3450 
3460 
3470 
3480 
3490 
3500 
3510 
3520 
3530 
3540 
3550 
3560 
3570 
3580 
3596 
3600 
3610 
3620 
3630 
36406 
3650 
3660 
3670 
3680 
3690 
3700 
3710 
3720 
3730 
374 
3750 
3760 
3776 
3780 
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COLLECTED ALGORITHMS (cont.) 


AANQAADAAAARAAAAAAAAAAAANNAAANAAANANAARAAAAANANNAANAANANAAANAANNNAANDNANANRAANDNNAAARAANANAAAN 


AANDNAARAANAAANANAANA 


THEN THE PROGRAM WOULD SET 

KFA(1)=L1 

KFA(2)=L2 

KFA(3)=L3 
A POINTER VALUE OF ZERO (KFA(I)=@) INDICATES SURFACE I 
WAS NOT UTILIZED IN DEFINING THE SOLID. HENCE GAPS MAY 
OCCUR IN THE SURFACE NUMBERS. ALSO, THE ORDER OF DATA 
ENTRY OF THE FACE LISTS CAN BE ENTIRELY ARBITRARY, 
BECAUSE OF THE AFORE-MENTIONED LINKAGE MECHANISM. 


LINKAGE TO SECONDARY FACE LISTS 


A FACE LIST IN THE ARRAY KV HAS THE FORM 
NSF,LSI,NA,NB,NC,...,NI,NJ,NK,...,NA 

WHERE NSF IC THE SURFACE NUMBER, NA,NB,... ARE VERTEX 

NUMBERS, AND LSI IS A LINK TO A SECONDARY FACE LIST. 

LSI=@ INDICATES THIS IS THE LAST FACE LIST FOR A SURFACE. 

NOTE, IT MAY BE THE ONLY LIST. 


INTEGRATION TECHNIQUE 


THE ALGORITHM IS PERFORMED BY TWO SUBROUTINES, PROPS AND 
SRFINT. 

SURFACES ARE PROCESSED ONE AT A TIME AND THE MASS 
PROPERTY CALCULATIONS ARE ACCUMULATED DURING THE 
PROCESSING. 

SURFACE PROCESSING INVOLVES STARTING WITH THE INITIAL 
FACE, AND PROCEDING THROUGH THE SECONDARY FACES, IF ANY. 
SURFACE AREA VECTOR COMPONENTS ARE SUMMED FOR EACE FACE 
OF THE SURFACE. THE AREA VECTOR, WHOSE MAGNITUDE IS THE 
AREA OF THE SURFACE, IS THEN COMPUTED FROM THE 
COMPONENTS AND IS ACCUMULATED IN THE TOTAL SURFACE 

AREA OF THE SOLID. 

IN THE FACE PROCESSING, FACES ARE DIVIDED INTO ALL 
UNIQUE TRIANGLES HAVING AS VERTICES THE THE FIRST ONE OF 
THE LIST AND ANY OTHER TWO ADJACENT VERTICES OF THE FACE 
POLYGON. FOUR-POINT GAUSSIAN QUADRATURE IS APPLIED TO 
EACH TRIANGLE, AND THE RESULTS ARE ACCUMULATED IN THE 
TOTAL MASS PROPERTIES. THUS EACH TRIANGLE OF EACH FACE 
OF EACH SURFACE HAS A CONTRIBUTION IN THE FINAL RESULTS. 


GLOBAL NOMENCLATURE 


AREA = SURFACE AREA OF SOLID 
AX, AY, 
AZ = SURFACE AREA VECTOR COMPONENTS ARRAYS 


CG = CENTER OF GRAVITY COORDINATE ARRAY 


DENS MASS DENSITY OF SOLID 

ERROR = LOGICAL ERROR INDICATOR 

ICG = COORDS OF MASS MOMENTS, WITH RESPECT TO CG 

Io = COORDS OF MASS MOMENTS, WITH RESPECT TO ORIGIN 

KFA = POINTER ARRAY. KFA(I) POINTS TO LOCATION IN KV 
OF INITIAL FACE LIST FOR SURFACE I. 

KV = FACE LISTS STORAGE ARRAY 

MAXS = NUMBER OF SURFACES ON SOLID 

MAXV = NUMBER OF VERTEX POINTS USED IN DEFINING SOLID 

NERR = ERROR CODE 

NS = CURRENT SURFACE NUMBER 

PR = COORDS OF PROD MOMENTS, WITH RESPECT TO ORIGIN 

PRCG COORDS OF PROD MOMENTS, WITH RESPECT TO CG 


< 
jo} 
ans 
fi it 


VOLUME OF SOLID 


= VERTEX COORDINATE ARRAYS 
WEIGHT = WEIGHT OF SOLID 


SUBROUTINE PROPS (KV,KFA,AX, AY, AZ, VX, VY, VZ) 


PURPOSE 


CALCULATES MASS PROPERTIES OF A GENERAL THREE 
DIMENSIONAL SOLID USING FOUR POINT GAUSSIAN QUADRATURE 
OVER TRIANGLES. 


DESCRIPTION 


CALCULATES CONTRIBUTION OF EACH SURFACE TO MASS 
PROPERTIES INTEGRALS. INTEGRATION IS PERFORMED IN 
SUBROUTINE SRFINT. MASS PROPERTIES CALCULATIONS ARE 
THEN COMPLETED IN THIS ROUTINE. DATA IS ASSUMED TO HAVE 
BEEN PREVIOUSLY SETUP IN STORAGE BY A DATA ENTRY ROUTINE. 


3790 
3860 
3810 
3820 
3830 
3846 
3856 
3860 
3876 
3880 
3890 
3960 
3910 
3920 
3930 
3946 
3950 
3960 
3976 
3980 
3990 
AOG0 
4610 
4620 
4030 
4040 
4050 
4960 
4670 
4080 
4090 
4100 
4110 
4120 
4139 
4140 
4150 
4160 
4170 
4180 
4190 
4266 
4210 
4220 
4236 
4240 
4250 
4260 
4270 
4286 
4290 
4300 
4316 
4320 
4330 
4349 
4350 
4360 
4370 
4380 
4390 
4460 
4416 
4420 
4430 
4440 
4450 
4460 
4479 
4480 
4490 
4566 
4510 
4520 
4530 
4540 
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COLLECTED ALGORITHMS (cont.) 


C 
Cc 
C 
C 


aaa 


LOCAL NOMENCLATURE 


NS 


= CURRENT SURFACE BEING PROCESSED 


LA = POINTER TO FACE LIST (INITIAL OR SECONDARY) DATA 


COMMON MAXS , MAXV, 


AREA, WEIGHT, VOL, DENS, 
CG(3) ,10(3) ,ICG(3) ,PR(3) ,PRCG(3), 
ERROR, NERR 


“DIMENSION KV(1) ,KFA(1) ,VX(L) ,V¥ (1) ,VZ(1) 


DIMENSION AX(1) ,AY (1) ,AZ(1) 
LOGICAL ERROR 
REAL I0,1CG 


CLEARING OF ACCUMULATION PARAMETERS. 


2 


AREA=0. 
VOL=0. 


AX(J) 


esos 


C EACH SURFACE IS PROCESSED. 


Cc 


DO 4 NS=1,MAXS 


C LA IS A POINTER TO THE FACE LIST DATA 


LA=KFA (NS) 
IF (LA .EQ. 6) GO TO 4 


C CONTRIBUTION OF EACH FACE OF CURRENT SURFACE IS CALCULATED 


3 


IF (KV(LA) .NE. NS) GO TO 5 
CALL SRFINT (KV(LA+2) ,AX,AY,AZ, VX, VY,VZ,NS) 


C CHECK IS MADE FOR SECONDARY FACE LIST. 


LA=KV (LA+1) 
IF (LA .NE. @) GO TO 3 


C AREA SUMMATION. 


aaa 


C 


4 


MASS 


AREA=AREA+SQRT (AX (NS) **2-++AY (NS ) **2+AZ (NS) **2) 
CONTINUE 


PROPERTY CALCULATIONS ARE COMPLETED. 


VOL=VOL/3.@ 

WEIGHT=VOL*DENS 

VOL2=VOL*2. 

VOL3=VOL/3.@ 

DENS2=DENS/2.@ 

DENS 3=DENS/3.@ 

CG(1)=CG(1) /VOL2 

CG(2)=CG(2) /VOL2 

CG(3)=CG (3) /VOL2 

10(1)=10(1)*DENS3 

10(2)=10(2) *DENS3 

10(3)=10(3) *DENS3 
ICG(1)=10(1)-(CG (2) **2+CG (3) **2) ‘WEIGHT 
ICG (2)=10(2)-(CG(1) **2+CG (3) **2) *WELGHT 
ICG(3)=10(3)—(CG(1) **2+CG (2) **2) *WEIGHT 
PR(1)=PR(1) *DENS2 

PR(2)=PR(2) *DENS2 

PR(3)=PR(3) *DENS2 
PRCG(1)=PR(1)-CG(1) *CG(2) *WELGHT 
PRCG(2)=PR(2)--CG(2) *CG(3) *WEIGHT 
PRCG(3)=PR(3)-CG(3) *CG(1) *WEIGHT 

RETURN 


C ERROR RETURN, DATA REDUNDANCY CHECK FAILED. 


Cc 


Cc 


5 


ERROR=.TRUE. 

NERR=5 

RETURN 

END 

SUBROUTINE SRFINT (KV,AX,AY,AZ,VX,VY,VZ,NS) 


C PURPOSE 


4550 
4560 
4576 
4580 
4596 
4606 
4616 
4620 
4630 
4646 
4650 
4660 
4670 
4680 
4690 
4700 
4710 
4720 
4730 
4740 
4750 
4760 
4770 
4780 
4790 
4800 
4810 
4826 
4830 
4846 
4850 
4866 
4870 
4880 
4896 
4906 
4916 
4920 
4936 
4940 
4950 
4960 
4976 
4980 
4996 
5006 
5016 
5020 
5030 
5040 
5050 
5060 
5070 
5080 
5090 
51066 
511¢ 
512¢ 
513¢ 
5140 
5150 
5160 
5176 
5186 
5190 
5200 
5210 
522¢ 
523¢ 
5240 
5250 
5260 
5276 
5280 
5296 
5360 
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COLLECTED ALGORITHMS (cont.) 
TO CALCULATE SURFACE INTEGRALS OVER A FACE OF A SOLID. 
DESCRIPTION 
DIVIDES FACE INTO TRIANGLES HAVING AS VERTICES THE 
FIRST VERTEX OF THE POLYGON AND TWO ADJACENT VERTICES 
OF THE POLYGON. NUMERICAL INTEGRATION IS PERFORMED 
RESULTS ARE ACCUMULATED TO GET TOTALS. 


LOCAL NOMENCLATURE 


AAQAAQAAAQAANAANAAANAAGAANAANAAAANAANANAAA 


ANX, 
ANY, 
ANZ = AREA VECTOR COMPONENTS FOR SINGLE TRIANGLE 
CX,CY, 
CZ = 1ST,2ND OR 3RD POWERS OF QUADRATURE COORDS, 
WEIGHTED AND AREA NORMALIZED 
PX,PY, 
PZ = QUADRATURE POINTS COORDINATE ARRAYS 
W = WEIGHTING FACTORS ARRAY 
X,Y,Z = FACE TRIANGLE COORDINATE ARRAYS 
COMMON MAXS , MAXV, 
AREA, WEIGHT, VOL, DENS, 


‘ CG(3) ,10(3) , ICG (3) ,PR(3) , PRCG(3) 
DIMENSION KV(1) ,AX(1) ,AY(1) ,AZ(1) , VX(1) , VY (1) ,VZ(1) 
DIMENSION X(3),¥(3),Z(3),PX(4) ,PY (4) ,PZ(4) ,W(4) 
REAL 10,ICG 


W(I) ARE WEIGHING FACTORS FOR 4-POINT GAUSSIAN QUADRATURE 
OVER TRIANGLES. 


ehen ee @) 


W(1)=-.5625 

W(2)=.52908333333333333 
W(3)=.5208333333333333 
W(4)=.5268333333333333 


THE POLYGON IS SEGMENTED INTO TRIANGLES, EACH HAVING THE 
FIRST VERTEX OF THE POLYGON AS THE FIRST POINT OF THE 
TRIANGLE. 


AaAaAaAN 


K=KV(1) 
X(1)=VX(K) 
¥ (1)=VY (K) 
Z(1)=VZ(K) 
DO 3 L=2,190¢ 
K=KV (L+1) 
C TESTING FOR END OF DEFINITION. 
IF (K .EQ. KV(1)) GO TO 4 
X (3)=VX(K) 
Y (3)=VY (K) 
Z(3)=VZ(K) 
K=KV (L) 
X(2)=VX(K) 
Y (2) =VY (K) 
Z(2)=VZ(K) 


DATA IS NOW IN TERMS OF A SINGLE TRIANGLE. 


aa 


PX(1)=(X(1)+X(2)+X(3))/3. 
PY (1)=(¥ (1)+¥ (2)+¥ (3))/3. 
PZ(1)=(Z(1)+Z(2)+Z(3))/3. 
DX=.6*PX(1) 
DY=.6*PY (1) 
DZ=.6*PZ(1) 
DO 1 I=1,3 
K=I+1 
PX(K)=DX+. 4*X (I) 
PY (K)=DY+. 4*Y (L) 
PZ(K)=DZ+. 4*Z (1) 


1 CONTINUE 
Cc. 
C AREA VECTORS CALCULATED. 
C 


ANX= . 5* (Z (1) * (Y (2) -¥ (3) )+Z (2) * (¥ (3)-Y¥ (1)) 
+Z (3) * (¥ (1)-¥ (2))) 
ANY= .5* (X(1)*(Z(2)-Z (3) )+X(2) * (Z(3)-Z(1)) 


USING FOUR-POINT GAUSSIAN QUADRATURE OVER THE TRIANGLES. 


531¢ 
532¢ 
533¢ 
5340 
5350 
5360 
53706 
5380 
5390 
5460 
54106 
5420 
5430 
5446 
5456 
5460 
5470 
5480 
5496 
5500 
551¢ 
5520 
5530 
5546 
5550 
5560 
5576 
5580 
5590 
5600 
5610 
5620 
5630 
5640 
5650 
5666 
5670 
568¢ 
5690 
5700 
5710 
5720 
5736 
5740 
575@ 
5760 
5770 
5780 
5796 
5800 
5810 
5820 
5836 
5840 
5850 
5860 
5876 
5880 
589¢ 
5900 
591¢ 
5920 
593¢ 
5946 
595¢ 
5960 
5970 
5986 
5990 
6600 
6010 
6020 
6030 
6040 
6050 
6060 
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COLLECTED ALGORITHMS (cont.) 


+X (3) *(Z(1)-2(2))) 

ANZ= . 5% (¥ (1) *(X(2)-K (3) )+¥ (2) * (X(3)-K(1)) 
+¥ (3) *(X(1)-X(2))) 

AX (NS)=AX (NS )+ANX 

AY (NS) =AY (NS)+ANY 

AZ (NS )=AZ (NS )+ANZ 


C 


C CALCULATION OF MASS PROPERTIES 


C 
DO 2 I=1,4 


C 1ST POWER OF INTEGRATION COORDINATES 
CX=ANX*PX (I) *W(L) 
CY=ANY*PY (I) *W(I) 
CZ=ANZ*PZ (1) *W(L) 

VOL=VOL+ (CX+CY+CZ) 
C 2ND POWER OF INTEGRATION COORDINATES 


CX=CX*PX (I) 
CY=CY*PY (I) 
CZ=CZ*PZ (1) 
CG(1)=CG (1)+CX 
CG (2)=CG (2) +CY 
CG (3) =CG (3) +CZ 


PR(1)=PR(1)+CX*PY (1) 
PR(2)=PR(2)+CY*PZ(L) 
PR(3)=PR(3)+CZ*PX (1) 

C 3RD POWER OF INTEGRATION COORDINATES 


CX=CX*PX (TL) 
CY=CY*PY (I) 
CZ=CZ*PZ(L) 


10(1)=10(1)+CY+CZ 
10(2)=10(2)+CZ+CX 
10(3)=10(3)+CX+CY 


2 CONTINUE 
3 CONTINUE 


4 CONTINUE 
RETURN 
END 


6070 
6080 
6090 
6169 
6110 
6126 
6130 
6146 
6154 
616% 
6170 
6180 
6190 
6200 
62106 
6220 
6230 
6240 
6250 
6260 
6270 
6280 
6290 
6300 
6316 
6320 
6330 
6340 
6350 
6360 
6370 
6380 
6390 
6400 
6416 
6426 
6430 
6440 
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ALGORITHM 551 | 

A Fortran Subroutine for the L, Solution of 
Overdetermined Systems of Linear 
Equations [ F4 | 


NABIH N. ABDELMALEK 
National Research Council, Ottawa, Canada 


Key Words and Phrases: overdetermined system of linear equations, discrete linear L; approxima- 
tion, linear programming, dual simplex algorithm, triangular decomposition 

CR Categories: 5.13, 5.41 

Language: Fortran 


DESCRIPTION 


This algorithm is a Fortran implementation for the procedure developed in [1] 
and [2]. It solves an overdetermined system of linear equations of the form 


Ca=f, 


in the LZ, norm. C is a given real n-by-m matrix of rank k = m = n and fis a given 
real n-vector. 
The L, solution to this system is the m-vector a* which minimizes the L; norm 


43 
z= ini, 
i=1 


where 7; is the ith residual and is given by 
r= > Cijaj — fis 
j=l 
This subroutine uses a dual simplex method and a suitable triangular decom- 
position method to the basis matrix. In [2] the testing of this subroutine, as well 
as numerical results and comments, are given. 
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1. ABDELMALEK, N.N. An efficient method for the discrete linear L; approximation problem. 
Math. Comput. 29 (1975), 844-850. 
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Math. Softw. 6, 2 (June 1980), 220-227. 


ALGORITHM 


Cc THIS PROGRAM IS A DRIVER FOR THE SUBROUTINE L1 

C WHICH SOLVES AN OVERDETERMINED SYSTEM OF LINEAR EQUATIONS 
C IN THE L1 NORM, USING A DUAL SIMPLEX METHOD. 

C THE OVERDETERMINED SYSTEM HAS THE FORM CA=F 

C C IS A GIVEN REAL N BY M MATRIX OF RANK K, K.LE.M.LE.N 
C F IS A GIVEN REAL N-VECTOR. 
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COLLECTED ALGORITHMS (cont.) 


C 
C 
Cc 
C 


A IS THE SOLUTION M-VECTOR. 


161 
102 
103 
104 
105 
106 
107 
198 
109 
110 
ele 
LS 
129 
125 
126 


ht 


DIMENSION AA(252, 27) 

DIMENSION FAY (8,250) ,EF(25@) 

DIMENSION CT(25, 25) ,F(25@) ,R(250) ,A(25) ,BINV(25,25) 
DIMENSION P(35@) ,1C(250) ,1B(250) ,¥ (250) ,TH(250) , IR(25) 
DIMENSION U(25),V(25) ,W(25) ,GINV(25, 25) ,VB(25) 

DIMENSION BV(25) , IBOUND(25@) , ICBAS (25) , IRBAS (25) ,2C (250) 
DIMENSION F1(50),F2(5@) ,BA(6, 15) 

INTEGER $ (250) 


FORMAT(1@H1EXAMPLE ,13,8H SIZE ,13,8H BY ,13) 
FORMAT(4@H@ R.H.S. OF THE SYSTEM ) 

FORMAT (4QH@TRANSPOSE OF COEFFICIENT MATRIX ) 

FORMAT (17H@EXECUTION TIME =,F12.5,13HSECONDS ) 

FORMAT (9H@L1 NORM=,F1@.5, 6H, RANK=,14,6H,ITER=,14, 5H, IND=,I4) 
FORMAT(4@H@THE ANSWER : A(I) OR X(I) ) 

FORMAT (4@H@RESIDUALS R(J) OR E(J) ) 

FORMAT (4@H@IC (1) ) 

FORMAT (4@H@IR (1) ) 
FORMAT(1H ,10@F12.5) 

FORMAT(1H ,2@14) 

FORMAT (9H@L1 NORM=,F1@.5, 6H,RANK=,F3.0, 6H, ITER=,F3.06,5H, IND=,F2.0) 
FORMAT(1H ,8F15.5) 

FORMAT (5F1@. 6) 

FORMAT (6F10@. 6) 


CALL SUNDER 
PREC=1.E-6 

EPS=1.E-4 

TOLER=1.@E-4 

MM=25 

MM2=MM+2 

MMM= (MM* (MM+3) ) /2 

NN=25@ 

NN2=NN+2 

TEXMPL=@ 

LEXMPL=IEXMPL+1 

GO TO (2,4,5,6,7,8,9,13,17,19, 20, 21,22, 26,27, 28, 29, 32, 35,100), 
*TEXMPL 


C EXAMPLE 1. 


2 


N=2@1 
DX=0.02 

DO 3 I=1,N 
X1=DX*FLOAT (I-1) 
X2=X1*X1 
X3=X2*X1 
X4=X2*X2 
X5=X3*X2 
X6=X3*X3 
X7=X3*X4 
FAY(1,1)=1. 
FAY (2,1)=X1 
FAY (3,1)=X2 
FAY (4,1)=X3 
PAY (5,i)=a4 
FAY (6,1)=X5 
FAY (7,1)=X6 
EF(1)= (EXP (—X1))*SIN(X1) 
M=1 

GO TO 10 
M=2 

GO TO 10 
M=3 

GO TO 1¢ 
M=4 

GO TO 1¢ 
M=5 

GO TO 16 
M=6 

GO TO 10 
M=7 

pO 12 J=1,N 
F(J)=EF(J) 
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COLLECTED ALGORITHMS (cont.) 


DO 11 I=1,M 


11 CT(I,J)=FAY (I,J) 


12 CONTINUE 
GO TO 90 


C EXAMPLE 2. 


13 N=1060 
N2=56 
M=6 


14 


15 
16 


DO 14 J=1,N2 
F(J)=F1(J) 
JN2=J+N2 
F(JN2)=F2 (J) 
DO 16 J=1,10 


D=@. 1* FLOAT (J) 


DD=D*D 


pO 15 I=1,19¢ 
E=@.1*FLOAT(T) 


EE=E*E 


K=1@* (J-1)+1 
CT(1,K)=1.6 


CT(2,K)=E 
CT (3,K)=D 


CT(4,K)=E*D 


CT(5,K)=EE 
CT(6,K)=DD 
CONTINUE 
CONTINUE 
GO TO 9¢ 


C EXAMPLE 3. 


17 


N=51 
M=8 
DO 18 I=1,N 


D=@.Q@2*FLOAT (1-1) 


DD=D*D 
DDD=D*DD 
El=D-@.1 
E2=D-@.2 
E3=D-@.4 
E4=D-@. 7 
E13=E1*E1*E1 
E23=E2*E2*E2 
E33=E3*E3*E3 
E43=E4*E4*E4 
CT(1,1)=1.¢ 
CT(2,1)=D 
CT(3,1)=DD 
CT(4,1)=DDD 


LF(E1.GT. 
-@.0) 
IF(E2.GT. 
IF(E2.LE. 
-0.0) 
IF(E3.LE. 
9.0) 
LF(E4.LE. 


IF(E1.LE 


IF(E3.GT 


LF(E4.GT 


0.0) 


9.9) 
0.) 


0.0) 
0.) 


18 F(L)= SQRT(D) 


GO TO 9¢ 


C EXAMPLE 4. 


19 M=6 


PI=4.@*ATAN(1. 


20 
21 


22 
23 


X@1=P1/2.6 
X@2=XO1*XO1 
X03=X@2*XO1 
XO4=XO2*XO2 
N=23 

GO TO 23 
N=53 

GO TO 23 
N=193 

GO TO 23 
N=203 
N2=N-2 
N3=N-3 


CT(5,1)=E13 
CT(5,1)=6. 
CT(6,1)=E23 
CT(6,1)=0. 
CT(7,1)=E33 
CT(7,1)=0. 
CT(8,1)=E43 
CT(8,1)=@. 


0) 


DX=P1/FLOAT (N3) 
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COLLECTED ALGORITHMS (cont.) 


2 


~ 


25 


DO 24 I=1,N2 
X1=-X01+DX* FLOAT (1-1) 
X2=X1*X1 

X3=X2*X1 

X4=X2*X2 

X5=X3*X2 

CT(1,1)=1.¢ 
CT(2,1)=X1 
CT(3,1)=x2 
CT(4,1)=X3 
CT(5,1)=X4 
CT(6,1)=X5 

F(1)= SIN(X1) 

G=-1.¢@ 

DO 25 I=1,2 
IF(1.EQ.2) G=1.0@ 
J=N2+1 

CT(1,J)=0.@ 

CT (2,J)=1000.0 

CT (3,J)=2000.O*G*XO1 
CT (4,3) =3000. O*XO2 
CT(5,J)=4900. O*G*XO3 
CT (6,5) =5000. O*XO4 
F(J)=6.0 

GO TO 9¢ 


C EXAMPLE 5. 


26 


27 


28 


29 


3¢ 


31 


M=11 

D=20.¢ 
DX=1.0/D 
N=21 

GO TO 36 
D=50.¢ 
DX=1.@/D 
N=51 

GO TO 30 
D=100.¢ 
DX=1.06/D 
N=1@1 

GO TO 3¢ 
D=260.@ 
DX=1.6/D 
N=201 

DO 31 I=1,N 
X1=DX* FLOAT (I-1) 
X2=X1+X1 
X3=X1+X2 
X4=X2+X2 
X5=X2+X3 
CT(1,1)=1.¢ 


CT(2,1)= 
CT(3,1)= 
CT(4,1)= 
CT(5,1)= 
CT(6,1)= 
CT(7,1)= 
CT(8,1)= 
CT(9,1)= 


CT(1,1)= SIN(X5) 
CT(11,1)= COS (X5) 


SIN(X1) 
cos (X1) 
SIN (X2) 
COS (X2) 
SIN(X3) 
COS (X3) 
SIN(X4) 
COS (X4) 


G= EXP (X1) 
Gl= EXP(@.5) 


F(I)=G1l 


IF(G.LT.G1) F(1)=G 


CONTINUE 
GO TO 9¢ 


C EXAMPLE 6. 


32 


33 


34 


M=5 
M1=M+1 
N=15 


DO 34 J=1,N 


READ (1,126) (BA(L,J) ,I=1,M1) 


DO 33 I=1,M 


CT(I,J)=BA(I,J) 


F(J)=BA(M1, J) 


CONTINUE 
GO TO 90 
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C EXAMPLE 7 


a 


QaQAaan 


AAO OAR AOA GOAAO AAA A COO OOO Aa oO 


35 


36 


99 


93 


1066 


M=5 
N=51 

DX=0. 02 

DO 36 I=1,N 

X1=DX* FLOAT (I-1) 

X2=X1*X1 

X3=X2*X1 

X4=X2*X2 

CT(1,1)=1.6 

CT(2,1)=X1 

CT(3,1)=X2 

€T G4, T)=x3 

CT(5,1)=X4 

GX=0.0 

IF(X1.GT.@.93) Gx=5.@ 

F(L)=X1* (1. G4+X1% (1. O+X1* (1. G+X1) ) )+6X 
CONTINUE 


WRITE (3,101) LEXMPL,N,M 
WRITE (3,102) 

WRITE (3,110) (F(J) ,J=1,N) 
WRITE (3,103) 

DO 93 I=1,M 

WRITE(3,110) (CT(1,J),J=1,N) 
CALL SETCLK 

CALL L1(M,N,MM,MMM,NN,CT,F,PREC,EPS,IC,IR,IB, 
*U,V,W,Y,TH,P,GINV, VB, [RANK, ITER,R,A,Z, IND) 
CALL RDCLK (TX) 

WRITE (3, 108) 
WRITE(3,111) (1C(L) , I=1,M) 
WRITE (3,169) 

WRITE (3,111) (IR(I) ,I=1,M) 
WRITE (3,107) 

WRITE (3,11) (R(J) , J=1,N) 
WRITE (3,106) 
WRITE(3,120) (A(1) , I=1,M) 
WRITE (3,105)Z,I RANK, ITER, IND 
WRITE (3,104) TX 

GO TO 1 

STOP 

END 


SUBROUTINE PSLV(ID,K,MM,MMM,P,B,X) 
THIS SUBROUTINE SOLVES THE SQUARE NON-SINGULAR SYSTEM 


OF LINEAR EQUATIONS 


P*X=B, 


OR THE SQUARE NON--SINGULAR SYSTEM OF LINEAR EQUATIONS 


P (TRANSPOSE) *X=B, 


WHERE P IS AN UPPER TRIANGULAR MATRIX, B IS THE RIGHT HAND 
SIDE VECTOR AND X IS THE SOLUTION VECTOR. 


ID 


“er A 


ies) 


THE INPUT DATA TO THE SUBROUTINE. 
AN INTEGER INDICATOR SPECIFIED BY THE USER. 
LF ID=1 THE EQUATION P*X=B IS SOLVED. 
IF ID= ANY INTEGER OTHER THAN 1, THE EQUATION 
P (TRANSPOSE) *X=B IS SOLVED. - 
AN INTEGER = THE NUMBER OF EQUATIONS OF THE GIVEN 
SYSTEM. 
AN INTEGER GREATER THAN OR EQUAL TO K. 
AN INTEGER = (MM*(MM+3))/2 
AN MMM-VECTOR. ITS FIRST (K+1) ELEMENTS CONTAIN THE 
FIRST K ELEMENTS OF ROW 1 OF THE UPPER TRIANGULAR 
MATRIX PLUS AN EXTRA LOCATION TO THE RIGHT. ITS 
NEXT K ELEMENTS CONTAIN THE (K-1) ELEMENTS OF ROW 2 
OF THE UPPER TRIANGULAR MATRIX PLUS AN EXTRA 
LOCATION TO THE RIGHT, ..., ETC. 
AN MM-VECTOR. ITS FIRST K ELEMENTS CONTAIN THE 
R.H.S. VECTOR OF THE GIVEN SYSTEM. 

THE OUTPUT OF THE SUBROUTINE. 
AN MM-VECTOR. ON EXIT, ITS FIRST K ELEMENTS CONTAIN 
THE SOLUTION TO THE GIVEN SYSTEM. 

DOUBLE PRECISION S,SA,SB 

DIMENSION P (MMM) ,B (MM) ,X (MM) 

IF(ID.NE.1) GO TO 3 


SOLUTION OF THE UPPER TRIANGULAR SYSTEM. 


PSLVOO106 
PSLVOGO20 
PSLVOO30 
PSLVO040 
PSLVOO50@ 
PSLVQOOE@ 
PSLVOO70 
PSLVOO8O 
PSLVOO9O 
PSLVO100 
PSLV@110 
PSLVO12@ 
PSLV@13@ 
PSLV@140 
PSLVO150 
PSLV@160 
PSLV@170 
PSLVG18@ 
PSLVG190 
PSLVO200 
PSLVO210 
PSLVO220 
PSLVO230 
PSLV@240 
PSLV@256@ 
PSLVO260 
PSLVO270 
PSLV@280 
PSLVO290@ 
PSLVO300 
PSLV@310 
PSLVO320@ 
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COLLECTED ALGORITHMS (cont.) 


L=(K-1)+(K* (K+1))/2 
X(K)=B(K)/P(L) 
LF(K.EQ.1) RETURN 
KD=3 

KM1=K-1 

DO 2 I=1,KM1 


SB=X(JJ) 
1 S=S-SA*SB 
X(J)=S/P(L) 
2 CONTINUE 
RETURN 


C SOLUTION OF THE LOWER TRIANGULAR SYSTEM. 


AAANAANAAANRQAAARAAAARAARAAANANNAANAAAANAA 


3 X(1)=B(1)/P (1) 
IF(K.EQ.1). RETURN 
L=1 
KD=K+1 
DO 5 I=2,K 

L=L+KD 

KD=KD-1 

S=B (I) 

KK=1 

KKM1=I-1 

KKD=K 

DO 4 J=1,KKM1 
SA=P (KK) 
SB=X(J) 
S=S-SA*SB 
KK=KK+KKD 
KKD=KKD-1 

4 CONTINUE 

5 X(L)=S/P(L) 
RETURN 
END 


SUBROUTINE L1(M,N,MM,MMM,NN,CT,F,PREC,EPS,IC,IR, IB, 

*UF, BP, XP,T,ALFA,P,GINV, VB, IRANK, ITER,R,A,Z, IND) 

THIS SUBROUTINE SOLVES AN OVERDETERMINED SYSTEM OF 
LINEAR EQUATIONS IN THE Ll NORM BY USING A DUAL SIMPLEX 
ALGORITHM TO THE LINEAR PROGRAMMING FORMULATION OF THE 
GIVEN PROBLEM. IN THIS ALGORITHM CERTAIN INTERMEDIATE 


SIMPLEX ITERATIONS ARE SKIPPED. 


FOR PURPOSE OF NUMERICAL STABILITY, THIS SUBROUTINE 
USES A TRIANGULAR DECOMPOSITION TO THE BASIS MATRIX. 
THE SYSTEM OF LINEAR EQUATIONS HAS THE FORM 


WHERE C IS A GIVEN REAL N BY M MATRIX OF RANK K.LE.M.LE.N 


C*A=F, 


AND F IS A GIVEN REAL N-VECTOR. 


THE PROBLEM TO BE SOLVED IS TO CALCULATE THE ELEMENTS 
OF THE M-VECTOR A* WHICH GIVES THE MINIMUM NORM Z. 
Z= ABS(R(1)) + ABS(R(2)) + ... + ABS(R(N)) 
WHERE R(1) IS THE ITH RESIDUAL AND IS GIVEN BY 
R(I)=C(1I,1)*A(1)+C(1,2)*A(2)+ ... +C(1,M)*A(M)-F(L). 
SUBROUTINE Ll IS COMPLETELY SELF CONTAINED (CONSISTS 


OF TWO SUBROUTINES Ll 


AND PSLV). 


THE INPUT DATA TO THE SUBROUTINE. 


M THE NUMBER OF COLUMNS OF MATRIX C. 

N THE NUMBER OF ROWS OF MATRIX C. 

MM AN INTEGER GREATER THAN OR EQUAL TO M. 

MMM AN INTEGER = (MM*(MM+3))/2 . 

NN AN INTEGER GREATER THAN OR EQUAL TO N. 

CT A MATRIX OF DIMENSIONS MM BY NN. ON ENTRY, ITS FIRST 


M ROWS AND FIRST N COLUMNS CONTAIN THE TRANSPOSE OF 


MATRIX C IN THE GIVEN SYSTEM C*A=F. 


F AN NN-VECTOR. ON ENTRY, ITS FIRST N ELEMENTS CONTAIN 
THE R.H.S. OF THE GIVEN SYSTEM C*A=F. 


’ 


PSLVO330 
PSLVO34@ 
PSLVO35@ 

PSLVO36 
PSLVO37@ 
PSLVG380 
PSLVO390 
PSLVQ400 
PSLV@410 
PSLV@42@ 
PSLVO430 
PSLVO440 
PSLVO45@ 
PSLVO46@ 
PSLV047@ 
PSLVO48@ 
PSLVO4906 
PSLVO500 
PSLVO510 
PSLVO52@ 
PSLVO53@ 
PSLVO54@ 
PSLVO55@ 
PSLVA56Q 
PSLVO57@ 
PSLVO58@ 
PSLVO59@ 
PSLVG600 
PSLVG610 
PSLVG620 
PSLVQ630 
PSLVG640 
PSLVQ650 
PSLVQ660 
PSLVQ670 
PSLVG680 
PSLVG690 
PSLVO7060 
PSLVO710 
PSLVQ720 
PSLVQ730 
PSLVO74@ 
PSLVO750 


Ll $01¢ 
Ll 9620 
Ll 9630 
L1 06640 
Ll @05¢ 
L1 060 
L1 60706 
Ll 608¢ 
Ll 60906 
Ll 6100 
L1 6110 
Ll $120 
Ll 6130 
Ll @14@ 
Ll 615¢ 
Ll 91606 
Ll 4170 
Ll 18@ 
Ll $196 
L1 $200 
Ll $2106 
Ll 6220 
Ll 6230 
Ll 246 
Ll $250 
Ll 6260 
Ll 6270 
Ll 628¢ 
Ll 6296 
Ll 6300 
L1 $310 
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COLLECTED ALGORITHMS (cont.) 


PREC THE ROUND-OFF LEVEL OF THE COMPUTER. FOR THE IBM 
360/67 COMPUTER, PREC IS ABOUT 1.E-6 AND 1.E~-16 FOR 
SINGLE AND DOUBLE PRECISION RESPECTIVELY. 

EPS A SPECIFIED TOLERANCE SUCH THAT A CALCULATED NUMBER 
X IS CONSIDERED ZERO IF ABS(X) <EPS. FOR THE IBM 360/67 
COMPUTER, EPS IS USUALLY TAKEN 1.E-4 AND 1.E-11 
RESPECTIVELY. 

THE RESULTS OF THE PROBLEM. 
IRANK THE CALCULATED RANK OF MATRIX C. 
ITER THE NUMBER OF ITERATIONS WHICH THE SOLUTION NEEDED. 


A AN MM-VECTOR. ITS FIRST M ELEMENTS ARE THE SOLUTION 
VECTOR A*. 

R AN NN-VECTOR. ITS FIRST N ELEMENTS CONTAIN THE 
THE RESIDUAL VECTOR R=C*A-F. 

Z THE MINIMUM L1 NORM OF THE RESIDUAL VECTOR R. 


IND A RETURN INDICATOR. IND=@ INDICATES THAT THE 
SOLUTION VECTOR A* IS UNIQUE. IND=1, INDICATES THAT 
A* IS MOST PROBABLY NOT UNIQUE. IND=-1 INDICATES 
PREMATURE TERMINATION OF THE CALCULATION DUE TO 
VERY ILL-CONDITIONING OF MATRIX C. 

THE MEANING OF THE OTHER PARAMETERS. 

GINV AN MM-SQUARE MATRIX. ITS FIRST IRANK COLUMNS AND 
FIRST IRANK ROWS CONTAIN THE INVERSE OF THE INITIAL 
BASIS MATRIX AND ITS UPDATE. 


VB AN MM-VECTOR. ITS FIRST IRANK ELEMENTS CONTAIN THE 
INITIAL BASIC SOLUTION AND ITS UPDATE. 
T AN NN-VECTOR. ITS FIRST N ELEMENTS CONTAIN THE 


ELEMENTS OF THE ROW IN THE SIMPLEX TABLEAU, THAT 
CORRESPONDS TO THE COLUMN WHICH LEAVES THE BASIS. 

ALFA AN NN-VECTOR. ITS FIRST N ELEMENTS CONTAIN THE 
RATIOS: ALFA(J) = R(J)/T(J). 


IC AN NN-VECTOR. ITS FIRST N ELEMENTS CONTAIN THE 
COLUMN INDICES OF MATRIX CT. 

IR AN MM VECTOR. ITS FIRST IRANK ELEMENTS CONTAIN THE 
ROW INDICES OF THE LINEARLY INDEPENDENT ROWS OF CT. 

IB A SIGN NN-VECTOR. ITS FIRST N ELEMENTS HAVE THE 


VALUES +1 OR -1. IB(J)=+1 INDICATES THAT COLUMN J 
IN THE TABLEAU IS AT ITS LOWER BOUND @. IB(J)=-1 
INDICATES THAT COLUMN J IS AT ITS UPPER BOUND 2. 

P AN MMM-VECTOR.: ITS FIRST ((IRANK* (IRANK+3) )/2)-1 
ELEMENTS CONTAIN THE (IRANK*(IRANK+1))/2 ELEMENTS OF 
THE UPPER TRIANGULAR MATRIX + EXTRA (IRANK-1) WORKING 
LOCATIONS. SEE THE COMMENTS IN SUBROUTINE PSLV. 


OFOQOAGAAAAOOOAAIAO OOOO AANA OAHAAaAO AAO oO AO OO HO OOO OO Onl oO 


BP AN MM-VECTOR. ITS FIRST LRANK ELEMENTS ARE THE 
R.H.S. OF THE TRIANGULAR EQUATIONS AS P*XP=BP. 
XP AN MM-VECTOR . ITS FIRST IRANK ELEMENTS ARE THE 
SOLUTION OF THE TRIANGULAR EQUATIONS AS P*XP=BP. 
UF AN MM-WORKING VECTOR. 


DOUBLE PRECISION S,SA,SB 
DIMENSION CT(MM,NN) ,F(NN) ,A(MM) ,GINV(MM,MM) , P (MMM) 
DIMENSION IC(NN),IB(NN) ,R(NN) , T(NN) ,ALFA(NN) , [R(MM) 
DIMENSION UF (MM) , BP (MM) , XP (MM) , VB (MM) 
IND=@ 
TPEPS=2.+EPS 
NMM= (M*¥ (M+3))/2 
LRANK=M 
ITER=@ 
DO 1 J=1,N 
IB(J)=1 
1 IC(J)=J 
DO 3 J=1,M 
IR(J)=J 
A(J)=@. 
DO 2 I=1,M 
2 GINV(I,J)=@. 
3. GINV(J,J)=1. 
LOUT=0¢ 
C PART 1 OF THE ALGORITHM. 
4 LOUT=LOUT+1 
IF(LOUT.GT.IRANK) GO TO 16 
PIV=0. 
DO 6 J=LOUT,N 
ICJ=1C(J) 
DO 5 I=IOUT, IRANK 
D=CT(I,1CJ) 
IF(D.LT.@.@) D=-D 


0326 
0330 
0340 
0356 
0360 
0370 
0380 
0390 
04060 
0410 
0420 
0430 
0440 
0450 
0460 
0470 
0480 
0490 
0500 
0516 
0520 
0536 
0540 
0550 
0560 
0570 
0580 
0590 
0600 
0610 
0620 
0630 
6646 
0650 
0666 
0670 
0686 
0690 
07060 
0710 
0720 
0730 
0740 
0750 
0760 
0770 
0780 
0790 
08060 
0810 
0820 
0830 
0840 
$85 
0860 
0870 
0880 
0890 
900 
0916 
0926 
0930 
0940 
0950 
0960 
0970 
0980 
0990 
14600 
1010 
1920 
163@ 
1940 
1050 
1960 
1070 
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COLLECTED ALGORITHMS (cont.) 


IF(D.LE.PIV) GO TO 5 
LI=1 
JIN=ICJ 
LJ=J 
PIV=D 
5 CONTINUE 
6 CONTINUE 
C DETECTION OF RANK DEFICIENCY. 
IF(PIV.GT.EPS) GO TO 7 
IRANK=I0UT-1 
IND=1 
GO TO 16 
7 IF(LI.EQ.IOUT) GO TO 10 
DO 8 J=1,N 
G=CT(LI,J) 
CT(LI,J)=CT(LOUT, J) 
8 CT(IOUT,J)=G¢ 
K=IR(LI1) 
IR(LI)=IR (IOUT) 
IR(IOUT)=K 
IF(IOUT.EQ.1) GO TO 10 
K=IOUT-1 
DO 9 J=1,K 
D=GINV(LI,J) 
GINV(LI, J)=GINV (IOUT, J) 
9 GINV(IOUT,J)=D 
C A GAUSS-JORDAN ELIMINATION STEP. 
1@ PIVOT=CT(LOUT, JIN) 
DO 11 J=1,N 
11 CT(LOUT,J)=CT(LOUT,J) /PIVOT 
DO 12 J=1,10UT 
12  GINV(LOUT,J)=GINV(IOUT,J) /PIVOT 
DO 15 I=1,IRANK 
IF(I.EQ.10UT) GO TO 15 
D=CT(I, JIN) 
DO 13 J=1,N 
13 CT(I,J)=CT(1,J)-D*CT (IOUT, J) 
DO 14 J=1,10UT 


14 GINV(I,J)=GINV(1,J)-D*GINV (IOUT, J) 


15 CONTINUE 
ITER=ITER+1 
K=IC(LJ) 

IC(LJ)=I1C (IOUT) 
IC (LOUT)=K 
GO TO 4 
C PART 2 OF THE ALGORITHM. 

16 ITRANK1=IRANK+1 

IRNKM1=IRANK-1 


C INITIAL RESIDUALS AND INITIAL BASIC SOLUTION. 


DO 17 J=1,IRANK 

ICJ=1C(J) 

R(ICJ)=0. 

17. ——*UF(J)=F(ICJ) 
DO 19 J=IRANK1,N 
ICJ=IC(J) 
=-F(ICJ) 

DO 18 I=1, RANK 
SA=UF (1) 
SB=CT(L,ICJ) 

18 S=S+SA*SB 

R(ICJ)=S 

I¥(S.GE.9.@) GO TO 19 

IB(ICJ)=-1 

19 CONTINUE 
DO 21 I=1,IRANK 

S=0. 

DO 20 J=1,N 
SA=CT(I,J) 
IF(IB(J).EQ.(-1)) SA=-SA 

20 S=S+SA 
21 VB(L)=S 
C INITIALIZING THE TRIANGULAR MATRIX. 
DO 22 T=1,NMM 
22 PC(I)=0. 
K=1 
KD=LRANK1 


168¢ 
1469¢ 
1100 
1110 
1120 
1130 
1140 
1156 
11606 
1170 
1180 
1190 
1200 
1210 
1220 
1230 
1240 
1250 
1260 
1270 
1280 
1296 
1300 
1310 
1326 
133¢ 
1346 
1350 
136¢ 
1370 
138¢@ 
139¢ 
1400 
1419 
1426 
1436 
1446 
145@ 
1466 
1476 
148¢ 
1496 
1500 
151¢ 
1520 
1536 
1540 
155@ 
1560 
1576 
1580 
159@ 
1600 
1616 
1620 
1636 
1640 
1650 
1660 
1670 
1686 
169@ 
1700 
1710 
1720 
173 
1740 
175@ 
1760 
1770 
1780 
1796 
18060 
1810 
1826 
1830 
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DO 23 I=1,IRANK 
P(K)=1. 
K=K+KD 

23 KD=KD-1 


C DETERMINE THE VECTOR WHICH LEAVES THE BASIS. 


24 IVO=0 


CALL PSLV(1, IRANK,MM,MMM,P,VB, XP) 


G=1. 
DO 27 I=1, [RANK 
E=XP (1) 
IF(E.LT.(-EPS)) GO TO 25 
IF(E.LE.TPEPS) GO TO 27 
D=2.@-E 
IF(D.GE.G) GO TO 27 
IVO=1 
GO TO 26 
25 D=E 
IF(D.GE.G) GO TO 27 
IVO=-1 
26 =6G=D 
IOUT=1 
XB=E 
27. + CONTINUE 
IF(IVO.EQ.@) GO TO 66 


C CALCULATION OF ROW (IOUT) IN THE TABLEAU. 


LCLOUT=IC(LOUT) 

T(ICIOUT)=1. 

BXB=XB 

DO 28 I=1,IRANK 
28 BP (1I)=@. 

BP (IOUT)=1. 


CALL PSLV(2,IRANK, MM, MMM, P, BP, XP) 


ALFMX=@. @ 

DO 31 J=IRANK1,N 
ICJ=1C(J) 
ALFA(ICJ)=@. 
S=0. 

DO 29 I=IOUT,IRANK 
SA=XP (I) 
SB=CT(I,ICJ) 

29 S=S+SA*SB 

E=S 

T(ICJ)=E 


IF(E.LT.EPS.AND.E.GT.(-EPS)) GO TO 31 


D=R(ICJ) 
IF(D.NE.@.@) GO TO 30 
D=PREC*PREC* FLOAT (IB(ICJ)) 
36 ALFA(ICJ)=D/E 
GG=ALFA(ICJ) 
IF(GG.LT.@.0) GG=-GG 
IF(GG.LE.ALFMX) GO TO 31 
ALFMX=GG 
31 CONTINUE 
PIVOTO=1. 
ITEST=@ 


C DETERMINE THE VECTOR WHICH ENTERS THE BASIS. 


GG=ALFMX+ALFMX 
32 ALFMX=GG 
ALFMN=-GG 
DO 35 J=IRANK1,N 
ICJ=1C (J) 
E=ALFA(ICJ) 
D=E* FLOAT (IVO) 
IF(D.LE.@.@) GO TO 35 
IF(IVO.EQ.1) GO TO 33 
IF(E.LE.ALFMN) GO TO 35 
ALFMN=E 
GO TO 34 
33 IF(E.GE.ALFMX) GO TO 35 
ALFMX=E 
34 JIN=J 
ITEST=1 
35 CONTINUE 
IF(ITEST.EQ.1) GO TO 36 


C NO FEASIBLE SOLUTION HAS BEEN FOUND. 


1840 
1850 
1860 
187@ 
1880 
1890 
1906 
1910 
1920 
1930 
1949 
1950 
1960 
1970 
198¢@ 
1996 
2600 
2010 
20620 
20630 
2040 
2050 
2060 
2070 
2086 
2090 
2100 
2110 
2120 
2130 
2140 
2150 
2160 
2170 
2180 
2190 
2200 
2210 
2226 
2230 
2240 
225¢ 
2260 
2270 
2280 
2290 
23060 
2310 
2320 
233¢ 
2340 
2350 
2360 
2370 
2380 
2390 
2400 
2410 
2426 
2430 
2440 
2450 
2460 
2470 
2480 
2490 
2506 
2510 
2526 
2530 
2546 
2550 
2560 
2579 
2580 
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36 


37 


38 


39 


40 


41 


42 


43 


IND=-1 

GO TO 66 

ICJIN=IC (JIN) 

PIVOT=T (ICJIN) 

ALPHA=ALFA (ICJIN) 

PIVOTN=PIVOT/PIVOTO 

IF(XB.GT.TPEPS) GO TO 37 

IF(PIVOTN.GT.@.) GO TO 39 

GO TO 41 

DO 38 I=1,IRANK 
E=CT(1I,ICIOUT) 
VB(L)=VB(1L)-E-E 

E=T (ICLOUT) 

BXB=BXB-E-E 

IB(ICIOUT)=~1 

IF(PLIVOTN.GT.@.) GO TO “41 

DO 4@ I=1, [RANK 
E=CT(I,ICJIN) 
VB(L)=VB(1I)+E+E 

E=T(ICJIN) 

BXB=BXB+E+E 

IB(ICJIN)=1 

XB=BXB/PIVOT 

IF(XB.GE. (-EPS) .AND.XB.LE.TPEPS) GO TO 42 

ITEST=0 

ALFA(ICJIN)=@. 

IF(ITEST.EQ.1) GO TO 43 

PIVOTO=PIVOT 

ICLOUT=ICJIN 

GO TO 32 

RCICJIN)=0. 

ITER=ITER+1 

IF(IOUT.EQ.IRANK) GO TO 46 


C UPDATING MATRIX (P,GINV,VB,CT). 


44 
45 
46 


47 


48 


DO 45 J=IOUT, IRNKML 
K=J 
K1=K+1 
KD=IRANK 
L=1C(K) 
IC(K)=IC(RK1) 
IC(K1)=L 
DO 44 I=1,K1 
P (K)=P (K+1) 
K=K+KD 
KD=KD-1 
CONTINUE 
L=1C (LRANK) 
IC(IRANK)=1C (JIN) 
IC (JIN) =L 
K=IRANK 
KD=IRANK 
DO 47 I=1,IRANK 
P(K)=CT (1, ICJIN) 
K=K+KD 
KD=KD-1 
IF (IOUT.EQ.IRANK) GO TO 58 
DO 57 I=IOUT,IRNKM1 
LI=1 
T1=1I+1 
K=@ 
KD=IRANK1 
DO 48 J=1,II 
K=K+KD 
KD=KD-1 
KK=K 
KL=K-KD 
L=KL 
G=P (K) 
D=P (L) 
IF(G.LT.@.0) G=-G 
IF(D.LT.@.@) D=-D 
IF(G.LE.D) GO TO 53 
DO 49 J=II,IRANK 
E=P (K) 
P (K)=P(L) 
P(L)=E 


2590 
2606 
2610 
2620 
2630 
2640 
265@ 
2660 
2670 
2680 
2690 
2700 
2716 
2720 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
2800 
2810 
2820 
2836 
2846 
2850 
2860 
2870 
2880 
2890 
2960 
2910 
2926 
2936 
2946 
2950 
2960 
297 


2986 
2990 
3000 
3016 
3020 
3030 
3040 
3050 
3060 
3070 
3080 
3690 
3160 
3110 
3120 
313¢ 
3146 
3150 
3160 
3176 
318¢ 
319¢ 
3200 
3216 
3220 
3230 
3240 
3250 
3260 
3270 
3280 
3296 
3300 
331¢ 
3320 
3330 
3346 
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49 


50 


51 


52 


53 


54 
55 
56 


57 
58 


59 


60 


61 


65 


K=K+1 
L=L+1 
J=IR(I) 
IR(L)=IR(11) 
IR(I1)=J3 
DO 5@ J=1,N 
E=CT(I,J) 
CT(I,J)=CT(T1,J) 
CT(11,J)=E 
DO 51 J=1, I RANK 
E=GINV(I,J) 
GINV(I,J)=GINV(I1,J) 
GINV(I1,J)=E 
DO 52 J=1,IRANK 
E=GINV(J,1) 
GINV(J,1I)=GINV(J,11) 
GINV(J,11)=E 
E=VB(L) 
VB(1L)=VB(I1) 
VB(11)=E 
E=P (KK) /P (KL) 
IF(E.LT.PREC.AND.E.GT.(-PREC)) GO TO 57 
K=KK 
L=KL 
DO 54 J=II,IRANK 
P (K)=P (K)-E*P (L) 
K=K+1 
L=L+1 
DO 55 J=1,N 
CT(11,J)=CT(I1,J)-E*CT(1,J) 
DO 56 J=1,IRANK 
GINV(I1,J)=GINV(I1,J)-E*GINV(I,J) 
VB(I1)=VB(11)-E*VB(I) 
CONTINUE 
DO 59 J=1,IRANK 
IcJ=1C (J) 
UF(J)=F(ICJ) 
IF (ALPHA.GT. (1.@).OR.ALPHA.LT. (-1.6)) GO TO 61 
DO 6@ J=IRANK1,N 
ICJ=1C(J) 
R(ICJ)=R(ICJ)-ALPHA*T (ICJ) 
GO TO 64 
CALL PSLV(2, IRANK,MM,MMM,P,UF,XP) 
DO 63 J=IRANK1,N 
ICJ=IC(J) 
3=-F (ICJ) 
DO 62 I=1,IRANK 
SA=XP (1) 
SB=CT(I,1ICJ) 
S=S+SA*SB 
R(ICJ)=S 
DO 65 J=IRANK1,N 
ICJ=IC(J) 
D=R(ICJ) *FLOAT (IB(ICJ)) 
IF(D.GE.@.0) GO TO 65 
R(ICJ)=0.0 
CONTINUE 
GO TO 24 


C CALCULATING THE ANSWER OF THE PROBLEM. 


66 


67 


68 


69 


CALL PSLV(2,IRANK,MM,MMM,P,UF,VB) 
DO 68 I=1,ITRANK 

S=¢. 

DO 67 K=1,ITRANK 
SA=VB (K) 
SB=GINV(K,1) 
S=S+SA*SB 

K=IR(I) 

A(K)=S 

S=¢. 
DO 69 J=1,N 

SA=R(J) 

IF(SA.LT.@.@) SA=-SA 

S=S+SA 

Z=S 
IF(IND.NE.@) RETURN 
E=2.-EPS 


3350 
3360 
3370 
3380 
339¢ 
3400 
3410 
3420 
3430 
3440 
3450 
3460 
3470 
3480 
3490 
3500 
351¢ 
352 
3536 
3540 
3550 
3560 
3570 
3580 
3596 
3600 
3610 
3620 
3630 
3640 
3650 
366¢ 
3670 
3680 
3690 
3700 
3710 
372¢ 
373¢ 
3746 
3750 
3760 
3770 
3780 
3790 
3806 
3810 
3820 
3836 
3840 
385 
3860 
3870 
3880 


3896 


3960 
3910 
3926 
3930 
3940 
3956 
3966 
3970 
3980 
3996 
4000 
4910 
4020 
4030 
4040 
4950 
4060 
4070 
4080 
4090 
4100 
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DO 70 I=1,IRANK 
D=XP (I) 
IF(D.LT.EPS.OR.D.GT.E) IND=1 

70 CONTINUE 


RETURN 
END 
1.478689 1.113268 6.855048 6.673991 @.541967 
0.442372 @.365257 @.304338 @.255453 6.215736 
1.027547 @.884824 6.730609 9.598496 @.492769 
0.408461 @.346883 @.286251 @.241692 0.205051 
0.692608 0.652965 @.577505 0.496487 6.422211 
0.357993 6.303718 @.258268 @.226102 6.188148 
0.443503 6.452751 6.427474 @.386389 @.341112 
0.297441 6.257776 0.222784 @.192393 6.166192 
@.251763 6.286357 @.291899 @.279565 .257866 
0.232626 6.207626 @.182721 @.166481 6.140547 
0.100448 @.149976 @.173775 .181324 6.177826 
0.167924 0.154817 @.140517 @.126221 6.112594 
-9.020740 0.035871 6.072667 @.093931 6.163914 
0.166235 0.103674 9.098224 @.091240 6.083607 
-9.118431 -0.057358 -6.012925 6.617763 @.0@37524 
0.049293 6.055315 @.057387 @.056853 0.054674 
-$.197141 -@.133831 -0.084691 -0.047765 -@.020895 
-0.901986 6.010826 6.019696 6.024961 @.026676 
-0.266162 -@.196048 -@.144211 -6.103189 -@.671395 
-0.947222 -@.029174 -0.015940 -0.006419 %.000282 
5. eF 4, 12.3 4, 
9, Ts 3. 19. 13. 
6. 6. Q. 12, Uae 
9, 9. 7: 25: 1s 
3. d. is 4, yah 
8. ai 8. 17s Is 
Te 9. 8. 18. 2. 
¢@. 9. 2 12, 6. 
3. 1. i 55 3. 
6. Te 6. 19. 7s 
6. 1. 9, 16. -2. 
d. 4. 8. 12 -4, 
Q. 5 Ts 12. -2. 
7 3. 2. ee 8. 
oe 4, 9, 18. Q. 
SUBROUTINE SUNDER 
Cc THIS IS A DUMMY SUBROUTINE. ITS FUNCTION IS TO 
C SUPPRESS THE UNDERFLOWS OCCURING IN THE CALCULATION. 
RETURN 
END 
SUBROUTINE SETCLK 
C THIS IS A DUMMY SUBROUTINE. ITS FUNCTION IS TC START 
C READING THE CPU TIME. 
RETURN 
END 
SUBROUTINE RDCLK(TX) 
C THIS IS A DUMMY SUBROUTINE. ITS FUNCTION IS TC RECORD 
C THE CPU TIME TX IN SECONDS, WHERE TX IS A REAL VARIABLE. 
TX=0. 40 
RETURN 
END 


ONDE HPrPUYUwWWNINN DS SN 


Ll 
LL 
LL 
Ll 
Ll 
L1 


4110 
4120 
4130 
4140 
4150 
4160 


0010 
9020 
0030 
0040 
0050 


9010 
$626 
0630 
$040 
0050 


$010 
bO20 
$030 
0040 
$050 
0060 
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ALGORITHM 552 
Solution of the Constrained /, Linear 
Approximation Problem [F4] 


i. BARRODALE and F. D. K. ROBERTS 
University of Victoria, Canada 


Key Words and Phrases: constrained /, approximation, linear programming, simplex method 
CR Categories: 5.13, 5.41 
Language: Fortran 


DESCRIPTION 


1. Introduction 


Given ak X n system of linear equations 


Ax = b, (1) 
the algorithm calculates an /; solution of (1) subject to / linear equality constraints 

Cx=d (2) 
and m linear inequality constraints 

Ex =f; (3) 


i.e., the subroutine determines a column vector x* which minimizes 
Rk 
|6 — Axl = ¥ (0: - Aix | (4) 
i=1 


subject to the given constraints (2) and (3). (In expression (4), b; denotes the ith 
component of 6 and A; denotes the ith row of A.) 

The method is completely general in the sense that no restrictions are imposed 
on the ranks of the matrices A, C, and £, or on the signs of the elements of f. 
Furthermore, if no vector x satisfying (2) and (3) exists, the subroutine detects 
this and informs the user that the problem is infeasible. 

The algorithm can be used to solve the constrained /; approximation problem. 
Suppose that data consisting of k points (¢i, yi) are to be approximated by a linear 
approximating function x1:(t) + xX2do(t) + +++ + Xndn(t), where certain linear 
constraints are imposed on the parameters x1, X2,..., Xn. This is equivalent to 
finding an J, solution to the system of equations 


>} b(t) x; = Yi, t=1,2,...,R, 
J=1 


subject to the given linear constraints. If the data values y; contain some large 
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errors, then an J, approximation may be preferable to an J, (least-squares) 
solution. This aspect of robust regression is discussed, for example, in [5, 7]. 

The algorithm is a modification of the simplex method applied to the primal 
formulation of the constrained J; problem as a linear program. The modification 
allows many intermediate simplex vertices to be bypassed, thus reducing the total 
number of simplex iterations required. A complete description of the method is 
given in [3]. In the absence of constraints, the algorithm reduces to our earlier 
unconstrained J; algorithm [1], which has proved to be most effective in practice. 
Indeed, in this case the program which follows produces identical results to the 
code given in [2]. 

Following [3], the constrained J; problem is posed as the following linear 
programming problem: 


minimize e(u+v) + Me’(w’ + vu’) + Me”v” 


subject to A(x’-—x”)+u —v=b6 


C(x'’-—x”")+u’ -—v’=d (5) 
E(x’ - x”) +u” —vp"” =f 
x’, x” =0, u,v = 0, u’,v’ = 0, u",v” =0. 


In (5), e, e’, and e” are vectors of 1’s of appropriate dimensions and vu’, vu’, and v” 
are artificial vectors with a large positive cost M in the objective function. Our 
modified simplex method is applied to a condensed tableau of size (k + 1+m+ 
2) X (n + 2), using the usual two-phase approach in which the artificial part of 
the objective function is minimized first. 

Our algorithm can be used to calculate a weighted constrained J; solution, 
merely by multiplying A; and 6; by a chosen positive weight before entering the 
subroutine. Also, as is explained in the comment section of our listing, simple 
nonnegativity constraints on the variables need not be included explicitly in the 
contraints (3), since these can be handled most efficiently by assigning the 
appropriate variables x;” in (5) a cost M in the objective function, thus making 
them artificial variables. Similarly, a nonnegativity constraint on the ith row 
b; — A.x can be handled by making the variable vu; in (5) artificial. 


2. Numerical Results 


The algorithm has been tested on a variety of problems, several of which are 
presented in [3]. We include here the following three additional test problems, 
which have been run on an IBM 370/158 using single-precision arithmetic 
(approximately 7 decimal digits). 

Example 1. Bartels et al. [4] present an example of a spline approximation due 
to Maurice Cox which is constrained to be convex. This corresponds to an J, 
solution of a 9 X 7 system of equations whose unknowns are subject to 5 inequality 
constraints. Our algorithm requires 10 simplex iterations to reproduce (to single- 
precision accuracy) the results given in [4], where 17 iterations of their penalty 
function technique are required. 


Example 2. This example was devised to demonstrate the ability of our 
algorithm to handle rank deficient problems. The matrices and vectors are defined 


as follows: 
2 0 1 3 1 7 
7 =A 4 15 7 4 
9 4 7 20 6 7 
2 2 1 5 3 4 
A=|9 3 2 14 1) &=/o} 
4 5 0 9 9 4 
4.4 9 17 -l1 9 
1 6 2 9 5 6 
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04 5 9 -1 5 
C=|3 2 7 12 -2], d=/11], 
3 6 12 21 -8 6 
03 6 9 -~3 5 
i= 62 4 12 ra r= [5]. 


The 8 < 5 matrix A is of rank 3. The 3 x 5 matrix C is of rank 2, which causes one 
artificial vector to remain in the basis at the end of phase I. Our algorithm 
includes an adaptation of a standard device (e.g., see Hadley [6, p. 153]) to handle 
such situations. The solution is obtained with no difficulty in 3 iterations with 
ERROR = 26.148. 


Example 3. Compute a best l; approximation by ps(t) = Y&1 x77! to the 
function y(t) = min(e’, e’””) on the 101 points defined by ¢ = 0(0.01)1, subject to 
the interpolation condition that ps(t) = y(t) for ¢t = 0, 0.5, and 1. This gives rise 
to a 98 X 6 overdetermined system with 3 equality constraints. The algorithm 
requires 8 iterations to solve the problem (with ERROR = 2.8513), and it requires 
13 iterations to solve the 101 x 6 overdetermined system without the 3 constraints 
(with ERROR = 1.1473). 
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ALGORITHM 
C SAMPLE DRIVER PROGRAM FOR SUBROUTINE CL1. 
C MAN 20 
C THIS PROGRAM SOLVES A K BY N OVERDETERMINED SYSTEM MAN 30 
C MAN 4@ 
Cc AX=B MAN 56 
Cc MAN 66 
C IN THE Ll SENSE SUBJECT TO L EQUALITY CONSTRAINTS MAN 70 
C MAN 80 
C CX=D MAN 90 
C MAN 100 
C AND M INEQUALITY CONSTRAINTS MAN 114 
C MAN 120 
C EX.LE.F. MAN 13¢ 
C MAN 144 
C COMPLETE DETAILS OF THE PARAMETERS MAY BE MAN 15¢ 
C FOUND IN THE DOCUMENTATION OF THE SUBROUTINE. MAN 160 
G MAN 17 
C THE ARRAYS ARE CURRENTLY DIMENSIONED TO ALLOW PROBLEMS MAN 18@ 
C FOR WHICH K+L+M .LE. 100, N .LE. 10. MAN 190 
C MAN 200 
C THE PROGRAM MAY BE TESTED ON THE FOLLOWING DATA. MAN 214 
Cc MAN 2206 
Cc K = 8 MAN 230 
Cc L = 3 MAN 246 
C M = 2 MAN 250 
Cc N= 5 MAN 266 
C MAN 276 
Cc Q=2 460 1 3 1 =7 MAN 28@ 
Cc 7 4 415 7 4 MAN 296 
C 9 4 726 6 7 MAN 360 
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Cc 2 Zk SB: 23d MAN 310 
Cc 9 3 21416 @ MAN 320 
C 4°95 @ 9 9 4 MAN 330 
C 4 4 917-1 9 MAN 340 
Cc 162 9 5 6 MAN 350 
Cc @ 4 5°9-1 5 MAN 360 
C SD AD 2? MAN 370 
C 3 612 21-3 6 MAN 380 
Cc @ 3 69-3 5 MAN 390 
Cc 6.2 412 4 <6 MAN 46¢ 
Cc MAN 416 
Cc KODE = @ MAN 420 
C TOLER = 1.E-5 MAN 43@ 
C ITER = 130 MAN 44@ 
C MAN 45@ 
C MAN 46@ 
DIMENSION Q(102,12), X(12), RES(1606), CU(2,11@) MAN 470 
INTEGER 1U(2,116), $(100) MAN 480 

DATA KLMD, KLM2D, NKLMD, N2D /100,1@2,1106,12/ MAN 49@ 

C INPUT DATA. MAN 500 
READ (5,99999) K, L, M, N, KODE, TOLER, ITER MAN 51@ 

KIM =K+4L+M MAN 52@ 

NI =N4+1 MAN 539 

DO 1@ I=1,KLM MAN 54@ 

READ (5,99998) (Q(1,J),J=1,N1) MAN 550 

WRITE (6,99994) (Q(1,J),J=1,N1) MAN 560 

1@ CONTINUE MAN 57@ 
CALL CLI(K, L, M, N, KLMD, KLM2D, NKLMD, N2D, Q, MAN 580 

* KODE, TOLER, ITER, X, RES, ERROR, CU, IU, S) MAN 59 

C OUTPUT KODE, ITERATION COUNT AND ERROR NORM. MAN 60@ 
WRITE (6,99997) KODE, ITER, ERROR MAN 61@ 

C OUTPUT SOLUTION VECTOR. MAN 620 
WRITE (6,99996) (1,X(1I),I=1,N) MAN 630 

C OUTPUT RESIDUAL ERROR AT EACH POINT. MAN 64 
WRITE (6,99995) (I1,RES(I),I=1,KLM) MAN 650 

STOP MAN 660 

99999 FORMAT (513, E1@.@, 13) MAN 670 
99998 FORMAT (8F3.@) MAN 680 
99997 FORMAT (16H KODE,ITER,ERROR, 2110, E18.7) MAN 69 
99996 FORMAT (4H SOL, I5, E18.7) MAN 700 
99995 FORMAT (6H ERROR, I5, E18.7) MAN 71¢ 
99994 FORMAT (2H , 8F5.0) MAN 72@ 
END MAN 73@ 
SUBROUTINE CL1(K, L, M, N, KLMD, KLM2D, NKLMD, N2D, CLl 1¢ 

* Q, KODE, TOLER, ITER, X, RES, ERROR, CU, IU, S) CLl 2@ 

C THIS SUBROUTINE USES A MODIFICATION OF THE SIMPLEX CL1 3¢ 
C METHOD OF LINEAR PROGRAMMING TO CALCULATE AN L1 SOLUTION CL1 4¢ 
C TO A K BY N SYSTEM OF LINEAR EQUATIONS CL1 56 
C AX=B CLL 6¢@ 
C SUBJECT TO L LINEAR EQUALITY CONSTRAINTS CLl 7@ 
C CX=D CL1 8¢@ 
C AND M LINEAR INEQUALITY CONSTRAINTS CLl 9¢ 
C EX.LE.F. CL1 10¢ 
C DESCRIPTION OF PARAMETERS CL1 110 
GK NUMBER OF ROWS OF THE MATRIX A (K.GE.1). CL1 12¢ 
CL NUMBER OF ROWS OF THE MATRIX C (L.GE.@). CL1 13¢ 
CM NUMBER OF ROWS OF THE MATRIX E (M.GE.@). CLI 14¢ 
CN NUMBER OF COLUMNS OF THE MATRICES A,C,E (N.GE.1). CL1 15 
C KLMD SET TO AT LEAST K+L4+M FOR ADJUSTABLE DIMENSIONS. CL1 16¢ 
C KLM2D SET TO AT LEAST K+L+M+2 FOR ADJUSTABLE DIMENSIONS, CL1 176 
C NKLMD SET TO AT LEAST N+K+L+M FOR ADJUSTABLE DIMENSIONS. CL1 180 
C N2D SET TO AT LEAST N+2 FOR ADJUSTABLE DIMENSIONS CL1 19¢ 
CQ TWO DIMENSIONAL REAL ARRAY WLTH KLM2D ROWS AND CL1 20¢ 
C AT LEAST N2D COLUMNS. CL1 21@ 
C ON ENTRY THE MATRICES A,C AND E, AND THE VECTORS CLL 2206 
Cc B,D AND F MUST BE STORED IN THE FIRST K+L+M ROWS CL1 23¢ 
C AND N+l COLUMNS OF Q AS FOLLOWS CL1 240 
Cc AB CL1 250 
C Q=CD CL1 26¢@ 
C EF CL1 276 
Cc THESE VALUES ARE DESTROYED BY THE SUBROUTINE. CL1 280 
C KODE A CODE USED ON ENTRY TO, AND EXIT CLL 290 
C FROM, THE SUBROUTINE. CL1 36¢ 
C ON ENTRY, THIS SHOULD NORMALLY BE SET TO @. CL1 310 
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HOWEVER, IF CERTAIN NONNEGATIVITY CONSTRAINTS 
ARE TO BE INCLUDED IMPLICITLY, RATHER THAN 
EXPLICITLY IN THE CONSTRAINTS EX.LE.F, THEN KODE 
SHOULD BE SET TO 1, AND THE NONNEGATIVITY 
CONSTRAINTS INCLUDED IN THE ARRAYS X AND 
RES (SEE BELOW). 
ON EXIT, KODE HAS ONE OF THE 
FOLLOWING VALUES 
¢- OPTIMAL SOLUTION FOUND, 
1- NO FEASIBLE SOLUTION TO THE 
CONSTRAINTS, 
2- CALCULATIONS TERMINATED 
PREMATURELY DUE TO ROUNDING ERRORS, 
3- MAXIMUM NUMBER OF ITERATIONS REACHED. 


TOLER A SMALL POSITIVE TOLERANCE. EMPIRICAL 


EVIDENCE SUGGESTS TOLER = 16**(-D*2/3), 

WHERE D REPRESENTS THE NUMBER OF DECIMAL 

DIGITS OF ACCURACY AVAILABLE. ESSENTIALLY, 

THE SUBROUTINE CANNOT DISTINGUISH BETWEEN ZERO 
AND ANY QUANTITY WHOSE MAGNITUDE DOES NOT EXCEED 
TOLER. IN PARTICULAR, IT WILL NOT PIVOT ON ANY 
NUMBER WHOSE MAGNITUDE DOES NOT EXCEED TOLER. 


ITER ON ENTRY ITER MUST CONTAIN AN UPPER BOUND ON 


RES 


THE MAXIMUM NUMBER OF ITERATIONS ALLOWED. 

A SUGGESTED VALUE IS 16*(K+L+M). ON EXIT ITER 
GIVES THE NUMBER OF SIMPT.EX ITERATIONS, 

ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST N2D. 
ON EXIT THIS ARRAY CONTAINS A 

SOLUTION TO THE Ll PROBLEM. IF KODE=1 

ON ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE 
SIMPLE NONNEGATIVITY CONSTRAINTS ON THE 
VARIABLES. THE VALUES -1, @, OR 1 

FOR X(J) INDICATE THAT THE J-TH VARIABLE 

IS RESTRICTED TO BE .LE.@, UNRESTRICTED, 

OR .GE.@ RESPECTIVELY. 

ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST KLMD. 
ON EXIT THIS CONTAINS THE RESIDUALS B-AX 

IN THE FIRST K COMPONENTS, D-CX IN THE 

NEXT L COMPONENTS (THESE WILL BE =@),AND 

F-EX IN THE NEXT M COMPONENTS. IF KODE=1 ON 
ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE SIMPLE 
NONNEGATIVITY CONSTRAINTS ON THE RESIDUALS 

B-AX. THE VALUES -1, @, OR 1 FOR RES(I) 

INDICATE THAT THE I-TH RESIDUAL (1.LE.1.LE.K) IS 
RESTRICTED TO BE .LE.@, UNRESTRICTED, OR .GE.@ 
RESPECTIVELY. 


ERROR ON EXIT, THIS GIVES THE MINIMUM SUM OF 


ABSOLUTE VALUES OF THE RESIDUALS. 

A TWO DIMENSIONAL REAL ARRAY WITH TWO ROWS AND 
AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. 

A TWO DIMENSIONAL INTEGER ARRAY WITH TWO ROWS AND 
AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. 
INTEGER ARRAY OF SIZE AT LEAST KLMD, USED FOR 
WORKSPACE. 


IF YOUR FORTRAN COMPILER PERMITS A SINGLE COLUMN OF A TWO 
DIMENSIONAL ARRAY TO BE PASSED TO A ONE DIMENSIONAL ARRAY 
THROUGH A SUBROUTINE CALL, CONSIDERABLE SAVINGS IN 
EXECUTION TIME MAY BE ACHIEVED THROUGH THE USE OF THE 
FOLLOWING SUBROUTINE, WHICH OPERATES ON COLUMN VECTORS. 


SUBROUTINE COL(V1, V2, XMLT, NOTROW, K) 


THIS SUBROUTINE ADDS TO THE VECTOR V1 A MULTIPLE OF THE 
VECTOR V2 (ELEMENTS 1 THROUGH K EXCLUDING NOTROW). 


10 
20 


30 
4g 


SEE 


DIMENSION V1(K), V2(K) 
KEND = NOTROW - 1 
KSTART = NOTROW + 1 
IF (KEND .LT. 1) GO TO 2@ 
DO 146 I=1,KEND 
VICI) = V1(1) + XMLT4V2(I1) 

CONTINUE 
IF(KSTART .GT. K) GO TO 4@¢ 
DO 3@ I=KSTART,K 

V1(1) = V1(I) + XMLT*V2(1) 
CONTINUE 
RETURN 
END 
COMMENTS FOLLOWING STATEMENT LABELLED 44@ FOR 


CL1 
CLI 


CL1 
CL1 
CLI 
CL1 
CLI 
CL1 
cL1 
CLL 
CL1 
CL1 
CL1 
CL1 
CLL 
CL1 
CL1 
CL1 
CLL 
CL1 
CL1 
CL1 
CLI 
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C INSTRUCTIONS ON THE IMPLEMENTATION OF THIS MODIFICATION. 


Cc 
C INI 
C 


C SET 


10 


20 
39 
C: SET 


40 


50 
60 


79 
80 


96 


100 


110 


DOUBLE PRECISION SUM 
DOUBLE PRECISION DBLE 


REAL Q, X, Z, CU, SN, ZU, ZV, CUV, RES, XMAX, XMIN, 


* ERROR, PIVOT, TOLER, TPIVOT 
REAL ABS 


INTEGER I, J, K, L, M, N, S, IA, II, IN, IU, JS, KK, 
* NK, Nl, N2, JMN, JPN, KLM, NKL, NK1, N2D, IIMN, 
* IOUT, ITER, KLMD, KLM1, KLM2, KODE, NKLM, NKLI1, 


* KLM2D, MAXIT, NKLMD, IPHASE, KFORCE, IINEG 
INTEGER IABS 
DIMENSION Q(KLM2D,N2D), X(N2D), RES(KLMD), 
* CU(2,NKLMD), IU(2,NKLMD), S(KLMD) 


TIALIZATION. 


KIM =K+L+M 
KLM1 = KLM + 1 
KLM2 = KLM + 2 
N + KLM 
1 


UP LABELS IN Q. 
DO 1¢ J=1,N 
Q(KLM2,J) = J 
CONTINUE 
DO 36 I=1,KLM 
Q(I,N2) =N+1 
IF (Q(I,N1).GE.@.) GO TO 3¢ 
DO 20 J=1,N2 
Q(1,J) = -Q(1,J) 


CONTINUE 
CONTINUE 
UP PHASE 1 COSTS. 
IPHASE = 2 
DO 40 J=1,NKLM 
cU(1,J) = @. 
cu(2,J) = ¢@. 
IU(1,J) = 9 
TU(2,J) = @ 
CONTINUE 


IF (L.EQ.@) GO TO 6@ 
DO 590 J=NK1,NKL 
cu(1,J) = 1. 
CU(2,J) 
Iu(1,J) 
1U(2,J) 
CONTINUE 
IPHASE = 1 


1. 
1 
1 


IF (M.EQ.@) GO TO 89 
DO 7@ J=NKL1,NKLM 

CU(2,J) = 1. 

1u(2,J) = 1 

JMN = J-N 

IF (Q(JMN,N2).LT.@.) IPHASE = 1 
CONTINUE 


IF (KODE.EQ.0) GO TO 15¢ 
DO 11@ J=1,N 
IF (X(J)) 90, 116, 100 
7; 


CONTINUE 
DO 14@ J=1, 
JPN = J 


+A 


CLL 
CLL 
CL1 
CL1 
CLL 
cLI 
CL1 
CL1 
CL1 
CL1 
CL1 
CLI 
CL1 
CLL 
CL1 
CLL 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CLL 
CL1 
CL1 
CLI 
CLI 
CL1 
CL1 
CL1 
CL1 
CL1 
CLL 
CL1 
CL1 
CLI 
cL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CLL 
CL1 
CL1 
CL1 
CLI 
CL1 
CLL 
CL1 
CL1 
CLL 
CL1 
CL1 
CL1 
CL1 
cL1 
CL1 
CL1 
CL1 
CL1 
cL1 
CLI 
CLI 
CLL 
CL1 
CLL 
CL1 
CL1 
CL1 
CLI 
CL1 
CL1 
CL1 
CLI 


1080 
1090 
1106 
111@ 
112¢ 
1130 
114@ 
115@ 
1166 
117@ 
118¢ 
119@ 
12060 
1216 
122¢ 
123¢ 
1240 
1256 
1260 
127 
128¢ 
1290 
1300 
1316 
1326 
1336 
1340 
1350 
136¢ 
1376 
138¢ 
1390 
1466 
141¢ 
1426 
1430 
1446 
145@ 
1466 
1476 
1480 
1490 
1500 
151¢ 
1520 
1530 
1546 
1550 
1560 
1570 
158¢ 
1596 
1600 
1610 
162 
163 
164¢ 
1650 
1666 
167@ 
1680 
1696 
1700 
1710 
172¢ 
1730 
1746 
1756 
1760 
177@ 
1786 
1790 
1806 
1810 
1820 
1830 
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IF (RES(J)) 120, 146, 13¢ 
120 CU(1,JPN) = 1. 
IU(1,JPN) = 1 
IF (Q(J,N2).GT.0.@) IPHASE 
GO TO 14¢ 
13¢ CU(2,JPN) = 1. 
IU(2,JPN) = 1 
IF (Q(J,N2).LT.@.0) IPHASE 
14@ CONTINUE 
15@ IF (IPHASE.EQ.2) GO TO 50@ 
COMPUTE THE MARGINAL COSTS. 
16¢ DO 20@ J=JIS,N1 
SUM = @.D@ 
DO 190 I=1,KLM 
IT. = Q(1,N2) 
IF (II.LT.6) GO TO 1706 
2. =U 1) 
GO TO 18¢ 
170 IINEG = -II 
Z = CUC2, FINEG) 
18¢ SUM = SUM + DBLE(Q(1,J)) *DBLE(Z) 
199 CONTINUE 
Q(KLM1,J) = SUM 
260 CONTINUE 
DO 23@ J=JS,N 
II = Q(KLM2,J) 
IF (II.LT.@) GO TO 214 
Z = CU(1,II) 
GO TO 220 
219 IINEG = -II 
Z = CU(2,1INEG) 
226 Q(KLM1,J) = Q(KLM1,J) - Z 
230 CONTINUE 
DETERMINE THE VECTOR TO ENTER THE BASIS. 
24@ XMAX = @. 
IF (JS.GT.N) GO TO 49¢ 
DO 28@ J=JS,N 


i 
st 


" 
re 


ZU = Q(KLM1,J) 

II = Q(KLM2,J) 

IF (II.GT.@) GO TO 256 

PY. =? SET 

ZV = ZU 

ZU = ~ZU - CU(1,II) = CU(2,II) 
GO TO 26¢ 


250 ZY 220 CUT) “=: CU TT) 


260 IF (KFORCE.EQ.1 .AND. II.GT.N) GO TO 284 


IF (IU(1,II).EQ.1) GO TO 27¢ 
IF (ZU.LE.XMAX) GO TO 27 
XMAX = ZU 
IN = J 
270 IF (1U(2,II).EQ.1) GO TO 284 
IF (ZV.LE.XMAX) GO TO 286 
XMAX = ZV 
IN = J 
280 CONTINUE 
IF (XMAX.LE.TOLER) GO TO 49¢ 
IF (Q(KLM1,IN) .EQ.XMAX) GO TO 340 
DO 299 I=1,KLM2 
Q(I, IN) =SQ (I » IN) 
290 CONTINUE 
Q(KLM1,IN) = XMAX 
DETERMINE THE VECTOR TO LEAVE THE BASIS. 
30@ IF (IPHASE.EQ.1 .OR. IA.EQ.%) GO TO 330 
XMAX = @. 
DO 31@ I=1,IA 
Z = ABS(Q(I,IN)) 
IF (Z.LE.XMAX) GO TO 31¢ 
XMAX = Z 
LOUr-=. 5 
316 CONTINUE 
IF (XMAX.LE.TOLER) GO TO 33@ 
DO 32¢ J=1,N2 
Z = Q(IA,J) 
Q(IA,J) = Q(IOUT,J) 
QCIOUT,J)-= Z 
320 CONTINUE 


CLI 
CL1 
CL1 
CLL 
CLL 
CL1 
CL1 
CL1 
CLI 
CL1 
CLI 
CLL 
CL1 
CL1 
CLI 
CLI 
CL1 
CL1 
CL1 
CLL 
CL1 
CLI 
CL1 
CLI 
CLI 
CLI 
CL1 
CL1 
CLL 
CLL 
CL1 
CL1 
CL1 
CLI 
CL1 
CcL1 
CL1 
CcL1 
CcL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CLL 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CL1 
CLI 
CL1 
CL1 
CLL 
CL1 
CL1 
CL1 


1846 
1850 
1860 
1870 
1880 
1890 
1900 
191¢ 
1920 
1930 
1946 
195¢@ 
1960 
1976 
1980 
1990 
2000 
2010 
2029 
2930 
2040 
2050 
2060 
2070 
2080 
2090 
2100 
2110 
2120 
2130 
2140 
2150 
216 
2170 
2180 
2190 
2200 
2210 
2220 
2230 
2246 
2250 
2260 
2270 
2280 
2290 
2300 
2310 
2320 
2330 
2340 
2350 
2360 
2370 
2380 
2390 
2400 
2410 
2420 
2430 
2440 
2450 
2460 
2470 
2480 
2496 
2500 
2519 
2520 
2530 
2540 
2550 
2560 
2570 
2580 
2590 
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AaAIAaAaAangd 


IOUT = IA 
IA = IA-1 
PIVOT = Q(IOUT,IN) 
GO TO 420 
33@ KK = @ 
DO 34@ I=1,KLM 
Z = Q(L,IN) 
IF (Z.LE.TOLER) GO TO 34@ 
KK = KK + 1 
RES(KK) = Q(I,N1)/Z 
S(KK) = I 
34@ CONTINUE 
35@ IF (KK.GT.@) GO TO 36¢ 
KODE = 2 
GO TO 59¢ 
36@ XMIN = RES(1) 
IOUT = S(1) 
A aa | 
IF (KK.EQ.1) GO TO 38@ 
DO 37@ I=2,KK 
IF (RES(I).GE.XMIN) GO TO 37¢ 


Jezel 
XMIN = RES(T) 
IOUT = S(T) 


37@ CONTINUE 
RES(J) = RES (KK) 
S(J) = S(KK) 
380 KK = KK - 1 
PIVOT = Q(LOUT,IN) 
IL = Q(IOUT,N2) 
IF (IPHASE.EQ.1) GO TO 40¢ 
IF (II.LT.@) GO TO 396 
IF (I1U(2,II).EQ.1) GO TO 42¢ 
GO TO 44 
39@ LINEG = -II 
IF (LU(1,IINEG).EQ.1) GO TO 426 
40@ II = IABS(II) 
CUV = CU(1,II) + CU(2,I1) 
IF (Q(KLM1,IN)-PIVOT*CUV.LE.TOLER) GO TO 42¢ 
BYPASS INTERMEDIATE VERTICES. 
DO 416 J=JS,N1 
Z = Q(IOUT,J) 
Q(KLM1,J) = Q(KLM1,J) - Z*CUV 
Q(LOUT,J) = -Z 
4106 CONTINUE 
Q(IOUT,N2) = -Q(IOUT,N2) 
GO TO 356 
GAUSS-JORDAN ELIMINATION. 
426 IF (ITER.LT.MAXIT) GO TO 43@ 
KODE = 3 
GO TO 59¢ 
43@ ITER = ITER + 1 
DO 44@ J=JS,N1 
IF (J.NE.IN) Q(IOUT,J) = Q(1OUT,J)/PIVOT 
440 CONTINUE 


IF PERMITTED, USE SUBROUTINE COL OF THE DESCRIPTION 
SECTION AND REPLACE THE FOLLOWING SEVEN STATEMENTS DOWN 


TO AND INCLUDING STATEMENT NUMBER 460 BY.. 
DO 46¢ J=JS,N1 
IF(J .EQ. IN) GO TO 460 
Z = -Q(IOUT, J) 
CALL COL(Q(1,J), Q(1,1IN), Z, IOUT, KLM1) 
46@ CONTINUE 
DO 46@ J=JS,N1 
IF (J.EQ.IN) GO TO 46@ 
Z = -Q(IOUT,J) 
DO 45@ I=1,KLM1 


IF (I.NE.IOUT) Q(I,J) = Q(1,J) + Z2*Q(1,=<N) 


450 CONTINUE 
460 CONTINUE 

TPLVOT = -PIVOT 

DO 47@ I=1,KLM1 

{IF (L.NE.IOUT) Q(I,IN) = Q(1,IN)/TPIVOT 

470 CONTINUE 

Q(IOUT,IN) = 1./PIVOT 

Z = Q(LOUT,N2) 
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CcL1 
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CL1 
cL1 
cL1 
CLI 
CLL 
CL1 
CL1 
CLL 
CL1 
CLI 
CL1 
CcL1 
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2600 
2616 
2626 
2630 
2640 
2650 
2660 
2670 
2680 
2696 
2700 
271¢ 
272¢ 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
2800 
2810 
2820 
2830 
2840 
2850 
2860 
2870 
2880 
2890 
2900 
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2930 
2946 
2950 
2960 
2970 
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30106 
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3040 
3050 
3060 
3070 
3080 
3090 
3100 
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3150 
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3170 
3180 
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3296 
3300 
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Q(IOUT,N2) 
Q(KLM2, IN) 
II = ABS(Z) 
IF (IU(1,IT) 


(cont.) 


Q(KLM2, IN) 
Z 


-EQ.@ .OR. IU(2,I1).EQ.0) GO TO 246 


DO 48@ I=1,KLM2 


Z = Q(1,IN) 
Q(I,IN) = Q(1,JS) 
Q(I,JS) = 2Z 
48Q@ CONTINUE 
Js = JS +1 
GO TO 246 


C TEST FOR OPTIMALITY. 
49% IF (KFORCE.EQ.@) GO TO 58@ 


IF (IPHASE.EQ.1 .AND. Q(KLM1,N1).LE.TOLER) GO TO 500 


KFORCE = @ 
GO TO 24¢ 


C SET UP PHASE 2 COSTS. 


5¢@ IPHASE = 2 


DO 519 J=1,NKLM 


cuU(1,J) = 
CU(2,J) = 
51@ CONTINUE 


Od. 
Od. 


DO 52@ J=N1,NK 
cU(1,J) = 1 


CU(2,J) = 
520 CONTINUE 


1. 


DO 56@ I=1,KLM 


II = Q(I,N2) 
IF (II.GT.@) GO TO 53¢ 
II = -II 


IF (IU(2,I1).EQ.@) GO TO 560 
cU(2,II) = @. 


GO TO 54@ 


530 IF (IU(1,II).EQ.@) GO TO 56¢ 
CU(1,II) = @. 
546 TA = IA+1 
DO 55@ J=1,N2 
Z = Q(1A,J) 
Q(TA,J) = Q(I,J) 


QI, J) 
550 CONTINUE 
56@ CONTINUE 
GO TO 160 


= Z 


57@ IF (Q(KLM1,N1).LE.TOLER) GO TO 5¢¢ 


KODE = 1 
GO TO 59¢ 


58@ IF (IPHASE.EQ.1) GO TO 57@ 


C PREPARE OUTPUT. 
KODE = @ 
590 SUM = @.DO 
DO 606 J=1,N 
X(J) = @. 
60% CONTINUE 


DO 61@ I=1,KLM 
RES(I) = @. 


610 CONTINUE 


DO 640 I=1,KLM 


II = Q(I,N2) 

SN = l. 

IF (I1.GT.@) GO TO 62¢ 
II = -II 

SN = -1 


620 IF (I1.cT 


.N) GO TO 63¢ 


X(II) = SN*Q(1,N1) 


GO TO 640 
630 LIMN = II 
RES (LIMN) 
IF (II.GE 
* DBLE (Q(I 
64@ CONTINUE 
ERROR = SUM 
RETURN 
END 


-N 

= SN*Q(I,N1) 

.N1 .AND. II.LE.NK) SUM = SUM + 
»N1)) 
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COLLECTED ALGORITHMS FROM ACM 


ALGORITHM 553 


M3RK, An Explicit Time Integrator for 
Semidiscrete Parabolic Equations [D3] 


J. G. VERWER 
Mathematical Center, Amsterdam, The Netherlands 


Key Words and Phrases: parabolic partial differential equations, semidiscretization, explicit time 


integrator 
CR Categories: 5.17 
Language: Fortran 


DESCRIPTION 


This algorithm is a complement to [2] where it is explained and described. 


REFERENCES 
1. RypErR, B.G. The PFORT verifier. Softw. Pract. Exper. 4 (1974), 359-378. 


2. VERWER, J.G. Animplementation of a class of stabilized explicit methods for the time integration 


of parabolic equations. ACM Trans. Math. Softw. 6, 2 (June 1980), 188-205. 


ALGORITHM 


OOQa GQ On A GQooaa marr OA an 


PROGRAM TEST1 (OUTPUT, TAPE6=OUTPUT) 


TEST PROGRAM 1 FOR J.G.VERWER'S ALGORITHM M3RK, AN EXPLICIT TIME- 
INTEGRATOR FOR SEMI-DISCRETE PARABOLIC EQUATIONS. 

THE TEST PROBLEM IS A SYSTEM OF 2 ONE-DIMENSIONAL PARABOLIC EQUA- 
TIONS WHICH IS DISCUSSED IN SECTION 5.1 OF J.G.VERWER'S COMPANION 
PAPER "AN IMPLEMENTATION OF A CLASS OF STABILIZED, EXPLICIT ME- 
THODS FOR THE TIME INTEGRATION OF PARABOLIC EQUTIONS". 

THE TEST CONSISTS OF THE INTEGRATION OF THE SYSTEM OF 122 ODE'S 
WHICH IS CALLED SYSTEM II IN SECTION 5.1 OF THE COMPANION PAPER 
(EQUATIONS (5.3) WITH 61 GRID POINTS FOR THE GALERKIN DISCRETI- 
ZATION). IN THE PRESENT TEST THE TOLERANCE PARAMETER TOL=1.@E-4. 


RRAKRERERRKRRERKERERRRRERERERERRRRERERRRRRERERRRERRRERERRRERRERERERK 


ARRAY DECLARATIONS FOR M3RK. THE ARRAY U IS THE INPUT ARRAY FOR 
THE INITIAL VECTOR AND UOUT IS THE OUTPUT ARRAY FOR THE COMPUTED 
SOLUTION VECTOR. 

DER IS THE SUBROUTINE DEFINING THE SYSTEM OF ODE'S. 

THE ARRAY X WILL CONTAIN THE GRID POINTS FOR THE GALERKIN DISCRE- 
TIZATION AND IS USED BY DER. 


DIMENSION INFO(15),U(122),U1(122),U2(122) , UOUT(122) ,DU(122) 
1,DU1(122),SIGMA(2) 

EXTERNAL DER 

COMMON /GRID/ X(61) 


DEFINITION AND PRINTING OF THE GRID POINTS X(I).THE NUMBER OF 
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C GRID POINTS CAN BE CHANGED BY REDEFINING NPTS AND BY ADJUSTING 
C THE LENGTH OT THE ARRAYS. 


C 


C 


1¢ 
12 


13 
14 


NPTS=61 

DO 1@ I=1,NPTS . 
X(1)=(FLOAT(1)-1.)/(FLOAT(NPTS )-1.) 
WRITE (6, 12) 

FORMAT (7H1 GRID=) 

DO 13 I=1,NPTS 

WRITE (6, 14)X(1) 

FORMAT (F12.5) 


C DEFINITION AND PRINTING OF THE INITIAL VECTOR FOR THE ODE'S. 


C 


CYC3 008 ©) 03 


QaAaa 


Qi Ore 


C 


20 


30 


WRITE(6, 20) 

FORMAT(17H1 INITIAL VALUES=) 
WRITE (6, 55) 

DO 36 I = 1, NPTS 

UCI) = 1. 

IN=I+NPTS 

UCIN) = .@ 

WRITE (6, 76)X(1),U(1I) ,UCIN) 
CONT INUE 


DEFINITION OF PARAMETERS FOR M3RK. NEQN GIVES THE NUMBER OF COM- 
PONENTS OF THE SYSTEM OF ODE'S. T IS THE INDEPENDENT VARIABLE. 


THE 


MEANING OF THE OTHER PARAMETERS IS CLEARLY EXPLAINED IN THE 


PROLOGUE OF COMMENTS OF M3RK. 


NEQN=NPTS*2 
T=. 
TOL=1.E-4 
INFO(1)=0 
INFO (2)=2 
INFO (3)=5000 


INITIAL AND SUBSEQUENT CALLS OF M3RK(SEE SECTION 5.1 OF THE 
COMPANION PAPER). TE DEFINES THE POINT WHERE OUTPUT IS DESIRED. 


DO 8@ I=1,6 

TE=. 01 

LIF(I.EQ.2)TEs.1 

IF(1.EQ.3)TE=1. 

IF(L.EQ.4)TE=5. 

IF(1.EQ.5)TE=10. 

IF(L.EQ.6)TE=20. 

CALL M3RK(T, TE,NEQN,H, HMIN,SIGMA, TOL, 


+ DER, U, U1,U2, UOUT, DU, DUI, IFLAG, INFO) 


PRINTING OF THE OUTPUT POINT, OF THE ERROR FLAG, OF THE ESTIMATED 
SPECTRAL RADIUS, OF THE ARRAY INFO, AND OF THE COMPUTED SOLUTION. 


4@ 


50 
55 
60 


70 
80 


WRITE (6, 40) TE, IFLAG, SIGMA(1) 
FORMAT(14H1 ENDPOINT =,E1@.4/10H IFLAG= ,12/8H SIGMA= 
1,£13.7) 

WRITE (6, 50) (INFO (KK) , KK=1, 15) 
FORMAT(8H INFO= ,1516/) 
WRITE(6, 55) 

FORMAT (5X, 1HX,17X, 1HU,19X, 1HV/) 
DO 6@ J=1,NPTS 

JN=J+NPTS 

WRITE (6, 70)X(J), VOUT (J) , UOUT (JN) 
FORMAT (F9.5, 2F20. 7) 

CONTINUE 

STOP 

END 


SUBROUTINE DER(N,Y) 


C SUBROUTINE DER DEFINES THE SYSTEM OF ODE'S BEING INTEGRATED. 
C THE ARRAY U IS A WORK ARRAY. 


C 


DIMENSION Y(N) ,U(122) 
COMMON /GRID/ X(61) 
FI (Z)=EXP(Z*5. 73)-EXP (-11. 46%Z) 
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COLLECTED ALGORITHMS (cont.) 


<i te Se» eh as la eae GA a Nae ae a OM a ee oo ar a Me te > 


GO. E OQ 


loge Ge gs Oe ee aAagaNgNANANA 


aAgMRANANAA 


DO 1@ I=1,N 
16 U(I)=¥(T) 
EPS=9.143 
P=. 1743 
Y(1)=-2. *EPS*P* (7. *U(1)-8. #U(2)+U(3)) / (X(3)-X (1) )**2-FI(U(1)-U (62) 


Y(62)=.@ 
¥ (122) =-2. *P*(7. *U(122)-8. *U(121)+U(120)) / (X(61)-X(59) ) ** 2+ 
LFI(U(61)-U(122)) 

DO 20 I=2,60,2 
Y(I)=-4. *EPS*P* (2. *U(1)-U(I-1)-U(I4+1)) / (X(14+1)-X (1-1) ) **2- 
1FI (U(1)-U(1I+61)) 

Y (I+61)=-4. *P* (2. *U(1+61)-U(1+60)-U(1+62)) / (X(1+1)-X(I-1)) 
1L** 2+FI (U(1)-UC(I+61)) 

2@ CONTINUE 

DO 3@ I1=3,59,2 

Y (1) =-2. *EPS*P*( (7. *U(1)-8. 4U(I-1)+U (1-2) ) / ((X(1+2)-X (1-2) )* 
1(X(1)-X(1-2)) )+(7. *U (1) -8. 4U (1+1)+U (1+2) ) / ((X(1+2) -X(I-2))* 
2(X(I+2)-X(1) )))-FI(U(1)-U(I+61)) 

Y(1I+61)=-2. *P*¥((7. *U(I+61)-8. *U(1+60)+U (1459) ) / ((X(1+2)-X(I-2)) * 
1(X(1)-X(1-2)))+(7. *U (I1+61)-8. *U (1+62 )+U(1+63)) / ((X(1+2)-X(1-2))* 
2(X(I1+2)-X(1) )))+FI (U(1)-U(I+61)) 

3@ CONTINUE 

RETURN 

END 


PROGRAM TEST 2 (OUTPUT, TAPE6=OUTPUT) 


TEST PROGRAM 2 FOR J.G.VERWER'S ALGORITHM M3RK, AN EXPLICIT TIME- 
INTEGRATOR FOR SEMI-DISCRETE PARABOLIC EQUATIONS. 

THE TEST PROBLEM IS THE SINGLE TWO-DIMENSIONAL PARABOLIC EQUATION 
WHICH IS DISCUSSED IN SECTION 5.2 OF J.G.VERWER'S COMPANION PAPER 
"AN IMPLEMENTATION OF A CLASS OF STABILIZED, EXPLICIT METHODS FOR 
THE TIME INTEGRATION OF PARABOLIC EQUATIONS". 

THE TEST CONSISTS OF THE INTEGRATION OF THE SYSTEM OF 2065 ODE'S 
WHICH IS CALLED SYSTEM II IN SECTION 5.2 OF THE COMPANION PAPER 
(EQUATIONS (5.6) WITH 5*41 GRID POINTS FOR THE GALERKIN DISCRETI- 
ZATION). IN THE PRESENT TEST THE TOLERANCE PARAMETER TOL=1.@E-4. 


RRKEREKRKRREREKERERRERRRREKRRERRRRRRRRERRRERERRRERERRRERRERRRERERKERRRKAKR 


ARRAY DECLARATIONS FOR M3RK. THE ARRAY U IS THE INPUT ARRAY FOR THE 
INITIAL VECTOR AND UOUT IS THE OUTPUT ARRAY FOR THE COMPUTED SOLUT- 
ION VECTOR. 

DER IS THE SUBROUTINE DEFINING THE SYSTEM OF ODE'S. 


DIMENSION INFO(15) ,U(205),U1(2065) ,U2(205) ,DU(205) ,DU1 (205), 
+U0UT (265), SIGMA( 2) 
EXTERNAL DER 


THE ARRAYS R AND Z WILL CONTAIN THE GRID POINTS USED BY THE GALERKIN 
DISCRETIZATION IN THE R-DIRECTION AND Z-DIRECTION, RESPECTIVELY. 


DIMENSION, R(5) ,Z(41) 


ARRAY DECLARATIONS FOR THE AUXILARY SUBROUTINE EVAL WHICH GENERATES 
THE GALERKIN COEFFICIENTS OCCURRING IN THE SYTEM OF ODE'S(SEE EQUA- 
TIONS (5.6),(5.7) IN THE COMPANION PAPER). EVAL IS CALLED ONCE IN 
THE TEST PROGRAM. 


COMMON /ARRAY /DIAG( 205) ,CO1(205) ,CO2( 205) , VRWZ( 205) ,WZ (205) 


DECLARATION OF SOME CONSTANTS NEEDED IN DER. M IS THE NUMBER OF 
GRID POINTS IN THE R-DIRECTION, N IS THE NUMBER OF GRID POINTS 
IN THE Z-DIRECTION. REND IS THE RIGHT BOUNDARY OF THE R-INTERVAL 


COMMON /CONST/M,N, REND 


DEFINITION OF THE GRID FOR THE GALERKIN DISCRETIZATION. WE PUT 
M=5 AND N=41. THESE NUMBERS MAY BE CHANGED, PROVIDED THE LENGTH 
OF THE ARRAYS ARE ADJUSTED. THE VALUE OF N MINUS 1 MUST BE A 
MULTIPLE OF 4. THE INTEGER MN DEFINES THE NUMBER OF COMPONENTS 
OF THE SYSTEM OF ODE'S. 
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COLLECTED ALGORITHMS (cont.) 


REND=1.E-4 
ZEND=@.15 
N=41 
M=5 
MN=M4N 
DR = REND/FLOAT(M-1) 
po 5 I= 1,M 
5 RCL) = DR*FLOAT(I-1) 
Z1=ZEND/1¢@. 
N1l=(N-1)/4 
DZR=Z1/FLOAT (N1) 
DZM=4. *DZR 
N2=N1+1 
N3=N24+1 
N4=34N 2-2 
N5=N44+1 
DO 6 I=1,N2 
6 Z(1)=DZR*FLOAT (I-1) 
pO 7 I=N3,N4 
7 Z(1)=Z(I-1)+DZM 
DO 8 I=N5,N 
8 Z(1I)=Z(1-1)+DZR 
C 
C PRINTING OF THE GRIDPOINTS. 
C 
WRITE (6, 20) 

2@ FORMAT(1H1,22H GRID POINTS ON R-AXIS) 
pO 22 I=1,M 
WRITE(6, 21)R(1) 

21 FORMAT(1H ,E14.8) 

22 CONTINUE 
WRITE (6, 23) 

23 FORMAT(1H1,22H GRID POINTS ON Z-AXIS) 
pO 25 I=1,N 
WRITE (6, 24)Z (1) 

24 FORMAT(1H ,E14.8) 

25 CONTINUE 
WRITE(6, 26) 

26 FORMAT (1H1) 


aaan 


DO 3¢@ I=1,M 
pO 3¢ J=1,N 
ITJM=1+(J-1)*M 
U(IJM) =500. 

3@ CONTINUE 
CALL UPRINT(M, N,MN,U,Z) 
CALL EVAL(R,M, Z,N, MN) 


PROLOGUE OF COMMENTS OF M3RK. 


OO Ooo 


T=¢. 
TOL=1.E-4 
INFO (1)=0 
INFO(2)=2 
INFO (3)=15000 


AaAaAN 


pO 9@ I=1,7 
TE=@.1 
LF(1.EQ.2)TE=. 
LF(L.EQ.3)TE=. 
LF(1.EQ.4)TE=. 
LF(1.EQ.5)TE=. 
LF(L.EQ.6)TE=. 
LF(L.EQ.7)TE=1.@ 

CALL M3RK(T, TE,MN,H,HMIN, SIGMA, TOL, 
LDER, U, U1, U2, UOUT, DU, DU1, IFLAG, INFO) 


wo mond fh 


Cc 


C PRINTING OF THE OUTPUT POINT, OF THE ERROR FLAG, OF THE ESTIMATED 


DEFINITION AND PRINTING OF THE INITIAL VECTOR OF THE SYSTEM OF 
ODE'S~UPRINT IS AN AUXILIARY PRINT ROUTINE-AND CALL OF EVAL. 


DEFINITION OF PARAMETERS FOR M3RK. T IS THE INDEPENDENT VARIABLE. 
THE MEANING OF THE OTHER PARAMETERS IS CLEARLY EXPLAINED IN THE 


INITIAL AND SUBSEQUENT CALLS OF M3RK (SEE SECTION 5.2 OF THE COM- 
PANION PAPER). TE DEFINES THE POINT WHERE OUTPUT IS DESIRED. 
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COLLECTED ALGORITHMS (cont.) 


C SPECTRAL RADIUS, OF THE ARRAY INFO, AND OF THE COMPUTED SOLUTION. 


C 


QAQAAAAANA 


WRITE (6, 50) TE, IFLAG, SIGMA(1) 


5@ FORMAT(1H1,13H ENDPOINT =,E1@.4/11H IFLAG = ,I2/ 


18H SIGMA=,E13.7) 
WRITE (6, 60) (INFO(KK) ,KK=1, 15) 


6@ FORMAT(1H ,7H INFO= ,15(15,1H )/) 


CALL UPRINT (M,N, MN, UOUT, Z) 


9@ CONTINUE 


STOP 
END 


SUBROUTINE EVAL(R,M,Z,N, MN) 


THIS SUBROUTINE COMPUTES, IN A STRAIGHT FORWARD MANNER, THE STANDARD 
INTEGRALS GIVEN IN FORMULA (5.7) OF THE COMPANION PAPER. THE ARRAYS 
IN WHICH THE RESULTING VALUES ARE STORED, ARE USED IN DER. BY INSPEC- 
TION OF DER AND FORMULAS (5.6)-(5.7), THE DEFINITION OF THE ARRAYS 
WILL BECOME CLEAR. 


1¢ 


15 


30 
40 


50 


DIMENSION R(M),Z(N) 

COMMON /ARRAY /DIAG(2@5) ,CO1( 205) ,CO2(205) , VRWZ( 205) ,WZ (205) 
WZ (1)=.@ 

DO 1@ I=1,MN 

DIAG(1)=.@ 

cO1(1I)=.¢@ 

CO2(I)=.¢ 

VRWZ(1)=.0@ 

CONTINUE 

M]=M-1 

N1=N-1 

DO 4¢@ I=1,M1 

RI=R(1) 

RIPLUS=R(I+1) 

DR=RIPLUS-RI 
WLEFT=DR* (2. *RI+RIPLUS) /6. 
WRGHT=DR* (RI+2. *RIPLUS) /6. 
WZ (1)=WZ (1)+WLEFT 

WZ (I+1)=WRGHT 

DO 3@ J=1,N1 

ZJ=Z (J) 

ZJPLUS=Z (J+1) 

DZ=ZIPLUS-ZJ 

ALFAI=WLEFT/ DZ 

ALFA 2=WRGHT / DZ 
BETA=(WLEFT+WRGHT) *DZ/ (2.@*DR*DR) 
VLEFT=WLEFT*DZ/2. 
VRGHT=WRGHT*DZ/2. 

L1=M* (J-1)+1 

L2=L1+1 

L3=L1+M 

L4=L3+1 

DIAG (L1)=DIAG(L1)+ALFA1+BETA 
DIAG (L2)=DIAG(L2)+ALFA2+BETA 
DIAG (L3) =DIAG(L3)+ALFA1+BETA 
DIAG (L4)=DIAG(L4)+ALFA2+BETA 
VPWZ (L1)=VRWZ(L1)+VLEFT 

VRWZ (L3)=VRWZ(L3)+VLEFT 

VRWZ (L2)=VRWZ (L2)+VRGHT 

VPWZ (L4)=VRWZ.(L4)+VRGHT 
CO1(L1)=CO1(L1)-BETA 
CO2(L1)=C02(L1)-ALFA1 
CO2(L2)=CO2(L2)-ALFA2 
CO1(L3)=CO1(L3)-BETA 
CONTINUE 

CONTINUE 

WZ1=WZ (1) 

DO 5@ J=1,N 

JM1=(J-1)*M+1 

WZ (J)=VRWZ (JML)/WZ1 

RETURN 

END 
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COLLECTED ALGORITHMS (cont.) 


AAAAND 


C 


C 


SUBROUTINE DER (MN, P) 


THE PRESENT SUBROUTINE DEFINES THE SYSTEM OF ODE'S WE ARE INTEGRATING. 
THE ARRAYS DIAG,CO1,CO2, VRWZ AND WZ ARE DEFINED IN EVAL. THE ARRAYS 
P AND V ARE WORK ARRAYS. 


DIMENSION P(MN),V( 205) 
COMMON / ARRAY /DIAG( 205) ,CO1(2@5) ,CO2( 2065) , VRWZ( 205) ,WZ( 205) 
COMMON / CONST /M,N, REND 


RLAM(X)=418. 4*((((.1287496E-13*X-.116873E-9) *X+., 384891E-6) 
L*X-. 569812E-3) *X+. 57185303) 

RHOC (X)= (146. 44+.018513*(X-1046. ))*193060. 

BRON (X)=7. 1486%*2*1. E-6% (~. 378808E-1+. 26 76 88E- 3*X+ 
1.17245 88E-7*X*X) / (3. 141593**2*1. E-16) 

EPST (X)=((((-. 270491E-17*X+. 3438691E-13) *X-.1639@5E-9)* 
1X+. 3305647E-6) *X-. 1194E-3)*X+.92667112 


DO 1@ I=1,MN 
1@ V(1)=P(T) 
DO 20 I=1,M 
P(I)=.0 
MNI=MN-M+I 
P(MNI)=.@ 
2@ CONTINUE 
M1=M+1 
MN 1=MN-M 
DO 30 I=M1,MN1 
IMM=I-M 
IPM=I+M 
P(1L)=-DIAG (1) *V(1)-CO1(I-1)*V(I-1)-CO1(1)*V(I+1) 
1-CO2 (IMM) *V (IMM)-CO2(1)*V(IPM) 
3@ CONTINUE 
N1=N-1 
DO 4@ J=2,N1 
JTM=J*M 
46 P(JTM) =P (JTM)—-REND*WZ (J) *EPST(V(JTM) ) /RLAM(V(JTM) ) 
1*5.6696E-84V (JIM) **4 
DO 5@ I=M1,MN1 
5@ P(1)=(P(1) *RLAM(V(1L) )/VRWZ(1)+BRON(V(I)))/RHOC (V(1)) 
RETURN 
END 


SUBROUTINE UPRINT(M,N, MN,U,Z) 


C A PRINT ROUTINE FOR THE COMPUTED SOLTUION VECTOR. 


DIMENSION U(MN),Z(N) 
WRITE (6, 1) 
L FORMAT (///4X, 1HZ,40X, 8HU(T,R, Z)/) 
DO 1@ I=1,N 
K=(I-1)*M 
KL=K+1 
KM=K+M 
10 WRITE(6, 20)Z(1), (U(J), J=K1, KM) 
2@ FORMAT(F10.6, 5X, 5F13. 6) 
RETURN 
END 


SUBROUTINE M3RK(X, XE,N,H,HMIN,SIGMA,TOL,F,Y, 


+ Y1,Y2, YXE, DY, DY1, IFLAG, INFO) 
CREKKEKRKRKAKRKKK KK EKER KERR RRR RRERE RRR RK ERE RE RERERERERERERERERERERERERE 
ABSTRACT 


cx 


* 


CREEKRRKRKREREKEKERRRERERKRERER RR ERERERRRRERRERERERERERER RRRERERERERRRERERERR 


Cx 
cx 
Cx 
Cx 
Cx 
cx 
Cx 
c* 
Cx 


M3RK IS DESIGNED TO SOLVE INITIAL VALUE PROBLEMS FOR SYSTEMS OF 
ORDINARY DIFFERENTIAL EQUATIONS OF THE FORM 
DY/DX=F(Y¥(1),...,Y(N)), 
Y¥(I) GIVEN AT X, 


WHICH ORIGINATE FROM SEMI-DISCRETIZATION OF INITIAL-BOUNDARY VALUE 


PROBLEMS FOR PARABOLIC PARTIAL DIFFERENTIAL EQUATIONS. M3RK IS 
BASED ON STABILIZED,EXPLICIT THREE-STEP RUNGE-KUTTA FORMULAS OF 
ORDER ONE AND TWO,OF WHICH THE DEGREE CAN VARY BETWEEN 2 AND 12. 


+e FF FF FF OF 
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COLLECTED ALGORITHMS (cont.) 


ce 
C* 
cx 
c* 
cx 
Cx 
c* 
c* 
c* 
cx 
c* 


Cx 


M3RK NEEDS 6 ARRAYS OF LENGTH N,WHICH ALL APPEAR IN THE CALL LIST. 

THE CODE INTEGRATES FROM X TO XE.ON NORMAL RETURN THE PARAMETERS IN 
THE CALL LIST ARE READY FOR CONTINUING THE INTEGRATION.TO CONTINUE 

THE INTEGRATION, THE USER NEEDS ONLY TO REDEFINE THE OUTPUT POINT XE 
AND CALL AGAIN. 


M3RK CALLS 11 SUBROUTINES WHICH HAVE BEEN WRITTEN TO STRUCTURE THE 
PROGRAM. THESE SUBROUTINES ARE: 
HSTART - HSTART COMPUTES THE INITIAL STEPLENGTH 
PARAM -— PARAM COMPUTES PARAMETERS OF THE VARIOUS IMPLEMENTED 
SCHEMES FROM THE COEFFICIENTS OF STABILITY POLYNOMIALS 
POWERM - POWERM ESTIMATES THE SPECTRAL RADIUS OF THE JACOBIAN OF F 
MAXDEG - MAXDEG COMPUTES THE MAXIMAL DEGREE OF THE FORMULAS, 
WHICH IS ALLOWED WITH RESPECT TO INTERNAL STABILITY 
MINDEG - MINDEG COMPUTES THE MINIMAL DEGREE OF THE FORMULAS, 


WHICH IS ALLOWED WITH RESPECT TO ABSOLUTE STABILITY 

STEP - STEP CONTAINS THE ACTUAL INTEGRATOR 

ESTIMA - ESTIMA COMPUTES A LOCAL ERROR BOUND AND ESTIMATES A LOCAL 
ERROR 

NEWH -—- NEWH DELIVERS A NEW STEPLENGTH 

INTER1 - INTER1 PERFORMS INTERPOLATION AFTER A CHANGE OF THE 
STEPLENGTH 

INTER2 - INTER2 INTERPOLATES THE SOLUTION AT THE OUTPUT POINT XE 


SHIFT - SHIFT SHIFTS THE DATA FOR A NEXT STEP 


THESE SUBROUTINES ARE COMPLETELY LOCAL,I.E.THE INFORMATION THEY 
NEED IS PASSED THROUGH THE PARAMETER LISTS.THE WHOLE PACKAGE HAS 
BEEN TESTED ON A CDC CYBER 73-28 USING AN ARITHMETIC PRECISION OF 
14 DIGITS.THE CODE POWERM USES THE CDC SYSTEM SUBPROGRAMS RANSET 
AND RANF CONSTITUTING A RANDOM GENERATOR.RANSET AND RANF MUST BE 
REPLACED WHEN USING THE PROGRAM ON ANOTHER COMPUTER. 

THE CODES CALLED BY M3RK USE NO MACHINE DEPENDENT CONSTANTS. 

M3RK USES ONE MACHINE DEPENDENT CONSTANT,NAMELY THE ARITHMETIC 
PRECISION OF THE COMPUTER.IN THE PROGRAM THE INTERNAL VARIABLE APR, 
WHICH REPRESENTS THE ARITHMETIC PRECISION,EQUALS 1.Q@E-14. APR MUST 
BE CHANGED ACCORDINGLY WHEN USING THE PROGRAM ON ANOTHER COMPUTER. 


THE WHOLE PROGRAM PACKAGE IS ACCEPTED BY THE PFORT VERIFIER.THE 
PFORT VERIFIER IS A PROGRAM WHICH CHECKS A FORTRAN PROGRAM,I.E. A 
MAIN PROGRAM AND SUBPROGRAMS, FOR.ADHERENCE TO PFORT,A PORTABLE 
SUBSET OF AMERICAN NATIONAL STANDARD FORTRAN(SEEI1 ).THE WHOLE 
PROGRAM PACKAGE IS COMPLETELY EXPLAINED AND DESCRIBED IN I2 . 


a ee ee i i i ee i i i 


CRERRRRRKRERERERRRKERERERERERERERRERERERERERRERRRREERRRERRRRERRRERRRERREERE 


Cx 


MEANING OF THE PARAMETERS 


* 


CREBEKKERKRAERERRERERERERERRRRRRRRERERERRRERRRRRRERERERRERERERRERRKERRRERRRER 


Cx 
cx 
Cx 
cx 
cx 
cx 
c* 
C* 
Cc* 
Cx 
cx 


c* 


x - VARIABLE : INDEPENDENT VARIABLE 

XE - EXPRESSION : OUTPUT POINT AT WHICH SOLUTION IS DESIRED 

N - EXPRESSION : NUMBER OF EQUATIONS 

H - VARIABLE : STEPLENGTH ° 

HMIN - VARIABLE : MINIMAL STEPLENGTH 

SIGMA — ARRAY : AN ARRAY OF LENGTH 2 CONTAINING ESTIMATES 
OF THE SPECTRAL RADIUS OF THE JACOBIAN OF F 

TOL - EXPRESSION : LOCAL ERROR TOLERANCE 

F - SUBROUTINE : DERIVATIVE 

Y - ARRAY : SOLUTION VECTOR AT X,INPUT AND WORK ARRAY 

Y1 - ARRAY : SOLUTION VECTOR AT X-H,WORK ARRAY 

Y2 - ARRAY : SOLUTION VECTOR AT X-2H,WORK ARRAY 

YXE  —- ARRAY : SOLUTION VECTOR AT XE,OUTPUT AND WORK ARRAY 

DY - ARRAY : DERIVATIVE VECTOR AT X,WORK ARRAY 

DY1 —- ARRAY : DERIVATIVE VECTOR AT X-H,WORK ARRAY 

IFLAG - VARIABLE : ERROR FLAG 

INFO —- ARRAY : INTEGER ARRAY OF LENGTH 15.INFO IS USED TO 
PASS INFORMATION TO INITIALIZE THE CODE,TO 
PASS INFORMATION BETWEEN THE MAIN PROGRAM AND 
THE SUBPROGRAMS,TO PASS INFORMATION TO THE 
USER ABOUT THE STATUS OF THE INTEGRATION, AND 
TO RETAIN INFORMATION FOR SUBSEQUENT CALLS. 


i ee 2 


CRERKEKARK RRR RRR RE REE RE RE RRERRERERRERERERERER RE ERER RR ERERRRERERRERR 


cx 


FIRST CALL TO M3RK 


* 


CRERRAKKERE EKER EKRE RR RERERR RRR ER EREERRERERERRRERE RR RE RERERRRRERRERERKRERER 


Cx 
cx 
cx 
cx 
cx 


THE USER MUST PROVIDE STORAGE IN HIS CALLING PROGRAM FOR THE ARRAYS 
IN THE CALL LIST.HE HAS TO SUPPLY THE SUBROUTINE F(N,Y) FOR 
EVALUATING THE DERIVATIVES DY(1)/DT,I=1,...,N,WHICH MUST BE OVER- 
WRITTEN ON Y(I).FOR THE SPECTRAL RADIUS THERE EXIST THREE OPTIONS 
WHICH MUST BE SELECTED WITH INFO(2).IN INFO(3) THE USER MUST GIVE 


* 
* 


be a 
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COLLECTED ALGORITHMS (cont.) 


c* A MAXIMUM FOR THE NUMBER OF EVALUATIONS OF F(Y) TO BE SPENT(ON RE- 
C* TURN IT MAY OCCUR THAT INFO(3) IS EXCEEDED WITH ABOUT 5@) 
CRRKKEKEKERERERERKKKEREERE 


C* INPUT PARAMETERS 
CARH RAKE RKARER ER RAKE RRR 


ce X - INITIAL VALUE OF THE INDEPENDENT VARIABLE 

C* XE - OUTPUT POINT AT WHICH SOLUTION IS DESIRED 

c* N - NUMBER OF EQUATIONS 

C* SIGMA - (1)= AN UPPER ESTIMATION OF THE SPECTRAL RADIUS OF THE JA- 
c* COBIAN OF F IN CASE OF OPTION 1.FOR OPTION 2 AND 3 NO 
cx INITIALIZATION IS REQUIRED 

c* TOL - LOCAL ERROR TOLERANCE 

c* Y¥ ~ VECTOR OF INITIAL VALUES OF THE DEPENDENT VARIABLES 

c* INFO - (1)= @ TO INDICATE FIRST CALL 

c* (2)= 1 TO INDICATE OPTION 1 FOR THE SPECTRAL RADIUS,I.E. 
cx THE USER MUST INITIALIZE SIGMA(1) 

c* = 2 TO INDICATE OPTION 2 FOR THE SPECTRAL RADIUS,I.E. 
cx THE CODE INITIALIZES SIGMA(1) AND CONTROLS SIGMA(1) 
cx = 3 TO INDICATE OPTION 3 FOR THE SPECTRAL RADIUS,I.E. 
cx THE CODE ONLY INITIALIZES SIGMA(1) AT THE FIRST CALL 
cx (3)= MAXIMUM NUMBER OF F(Y) EVALUATIONS TO BE SPENT 


CREKKEKKKAKAEKERERERERERER 


C* OUTPUT PARAMETERS 

CREKERKERKERRREREREREREEE 

c* X - LAST POINT REACHED IN INTEGRATION.NORMALLY X IS SLIGHTLY 
c* BEYOND XE 

c* - INITIAL STEPLENGTH FOR SUBSEQUENT CALL 

C* HMIN - MINIMAL STEPLENGTH USED BY M3RK 

c* SIGMA - (1)= UPPER ESTIMATION OF THE SPECTRAL RADIUS INITIALIZED BY 
cx THE USER OR BY POWERM 

c* - (2)= INACCURATE ESTIMATION OF THE SPECTRAL RADIUS USED FOR 
ck ITS CONTROL 

c* ¥ - SOLUTION VECTOR AT X 

c* Y1 - SOLUTION VECTOR AT X-H 

c* ¥2 - SOLUTION VECTOR AT X-2H 

C* YXE -— SOLUTION VECTOR AT OUTPUT POINT XE 

cx DY - DERIVATIVE VECTOR AT X 

c* DY1 ~ DERIVATIVE VECTOR AT X-H 

C* IFLAG - = @ NORMAL RETURN,I.E.OUTPUT POINT IS REACHED 

c* = 1 OUTPUT POINT IS NOT REACHED.THE MAXIMIJM NUMBER OF 

c* F(Y)-EVALUATIONS HAS BEEN SPENT.THE PROCESS CAN BE CON- 
cx TINUED BY INCREASING INFO(3) AND CALLING AGAIN 

c* = 2 MAXIMAL DEGREE FALLS OUTSIDE THE RANG? AS TOL/APR IS 
cx TOO SMALL.THE PROCESS IS NOT STARTED 

c* = 3 POWERM FAILED IN THE ESTIMATION OF THE SPECTRAL RADIUS. 
c* THE PROCESS IS DISCONTINUED 

c* INFO - (1) = 1 TO INDICATE THAT THE NEXT CALL IS A SUBSEQUENT ONE 
cx (2) = 1 IN CASE OF OPTION 1 OR 3,ELSE 2 

ck (3) = UNCHANGED 

c* (4) = TOTAL NUMBER OF INTEGRATION STEPS PERFORMED,I1.E. 

cx ACCEPTED AND REJECTED ONES 

c* (5) = NUMBER OF REJECTED INTEGRATION STEPS 

c* (6) = NUMBER OF RESTARTS INITIATED BY THE CODE 

c* (7) = TOTAL NUMBER OF DERIVATIVE EVALUATIONS 

cx (8) = NUMBER OF DERIVATIVE EVALUATIONS USED FOR THE ESTIMA- 
cx TION AND CONTROL OF THE SPECTRAL RADIUS 

cx (9) = CURRENT DEGREE 

cx (19)= MAXIMAL DEGREE FOR THE FIRST ORDER FORMULAS 

c* (11)= MAXIMAL DEGREE FOR THE SECOND ORDER FORMULAS 

cx (12)= CURRENT ORDER 

cx (13)= NUMBER OF STEPS PERFORMED AFTER START OR RESTART 

cx (14)= NUMBER OF STEPS PERFORMED AFTER CHANGE OF H OR ORDER 
cx (15)= NUMBER OF STEPS PERFORMED AFTER ESTIMATION OF SPEC- 
c* TRAL RADIUS 

cx 


C* IT IS EMPHASIZED THAT THE OUTPUT LIST GIVEN ABOVE IS NOT STRICTLY 
C* VALID WHEN ON RETURN IFLAG IS EQUAL TO 2 OR 3. 

cx IT IS FURTHER EMPHASIZED THAT ON RETURN THE ARRAY Y ALWAYS CONTAINS 
C* THE SOLUTION VECTOR AT THE POINT X.THUS WHEN IFLAG=3,THE USER HAS 
C* THE POSSIBILITY TO RESTART THE PROCESS AT THE POINT X,PROVIDED HE 
C* IS ABLE TO TAKE ACTION WITH RESPECT TO THE ESTIMATION OF THE SPEC- 
C* TRAL RADIUS. 

CRERKEKEKAKRERAKERERRERE RK RE RE RERE RE RE RRR EERE RE REREREREERER ERR ERE ERERERER 


C* SUBSEQUENT CALLS TO M3RK * 


a ee a ee a ee i i i i i i i i i i i i i i i i i i i i ee, 


900 

910 

92¢ 

930 

946 

950 

960 

979 

98¢ 

990 
100¢ 
1610 
1020 
1030 
1640 
1050 
1960 
1070 
198¢ 
1990 
1106 
1110 
1120 
113¢ 
114¢ 
115¢@ 
1160 
1170 
118¢ 
119¢ 
1200 
121¢ 
1220 
123¢ 
1249 
1250 
126¢@ 
1270 
1280 
129¢ 
1300 
1310 
1320 
133@ 
1340 
135¢@ 
1360 
1370 
1380 
1390 
14606 
1416 
1420 
1430 
1446 
1450 
146¢ 
1470 
1480 
149¢ 
156¢ 
151¢ 
152¢ 
1530 
154@ 
155@ 
156@ 
1570 
1580 
159@ 
160¢ 
1610 
162¢ 
163¢ 


553-P8 - 


0 
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CRARRKARAKKKRKAKKK EKER KK KK RREK KK RRKKER RRR RE RRR ER RRR ERK RRR RRR ERERERREEK 1640 
C* ON RETURN OF M3RK ALL PARAMETERS ARE READY FOR CONTINUING THE INTE- * 1650 
C* GRATION,PROVIDED IFLAG IS NOT EQUAL TO 2 OR 3.IF XE IS REACHED AND * 1660 
C* A NORMAL CONTINUATION IS DESIRED,THE USER NEEDS ONLY TO DEFINE A NEW* 1670 


C* OUTPUT POINT XE AND CALL AGAIN.IF ON RETURN IFLAG=1 AND THE USER * 1686 
c* WANTS TO CONTINUE,HE ONLY NEEDS TO INCREASE INFO(3) AND CALL AGAIN. * 1690 
C* THE PROGRAM IS WRITTEN IN SUCH A WAY THAT THE CHOICE OF OUTPUT * 1700 
c* POINTS DOES NOT AFFECT THE INTEGRATION PROCESS ITSELF.BETWEEN SUB- * 171¢ 
C* SEQUENT CALLS THE USER MAY INCREASE TOL.ALL OTHER PARAMETERS MUST * 1726 
C* REMAIN UNCHANGED. THE COUNTERS IN INFO ARE USED ACCUMULATIVELY. * 1730 


CHR RRAREK EKER KR RK RR ER ER RR ERER RE RR ER ER ER ER ER RRR RR ERE ER AERER ER RRRERERERERE 1740 
C* PROGRAM TEXT * 1L7>y 
CRA KKK KK KK RE RK EKER RK RRR RR RR RE RE RE RR RR RR ER ER ERER ER RRERERERERERERRERERRER = 1760 


DIMENSION Y(N) ,Y1(N),Y2(N), YXE(N) ,DY(N) ,DY1(N) ,SIGMA(2), INFO(15) 1770 


CRE KKKKKEKKKEKRKRKEKRRERREERKKRRRERREREERKE * 178¢ 
C* MEANING OF THE INTERNAL VARIABLES * 1790 
CHR KKEKRKAKRARE KKK EERE ER ERERERARERER * 1800 
C* ALFA - THE FACTOR FOR CHANGING THE STEPLENGTH * 181¢ 
Cx APR ~ THE ARITHMETIC PRECISION * 1826 
CX HOLD - PREVIOUSLY ACCEPTED STEPLENGTH * 1830 
C* MOLD - PREVIOUSLY USED DEGREE * 1840 
Cx REJECT -— NUMBER OF SUCCESSIVE STEP FAILURES * 1856 
cx B - NONZERO B-PARAMETERS OF THE SCHEME * 18606 
ck C¢ - C-PARAMETERS OF THE SCHEME * 1870 
cx LA - LABDA-PARAMETERS OF THE SCHEME * 1880 
C* HMAX -— MAXIMAL STEPSIZES WITH RESPECT TO ABSOLUTE STABILITY * 1890 
c* EPS - LOCAL ERROR BOUND * 1906 
C* ERROR - ESTIMATED LOCAL ERROR * 1910 
C¥&RKAKEKRAKKERERERERERRKRERKRRRRERRERARRRAERRKREKRERERRRRRRRR RRR ERRRRRKRERERERER 1926 

INTEGER REJECT 1930 

REAL LA 194¢ 

DIMENSION B(2),C(12),LA(12),HMAX(2) 195° 

EXTERNAL F 1960 


CR & KARAAKKKAK KK AK ER ARERR RRKER ERR AER RERERR REE RERE RE RRR RRR RERERERERERERERE 1970 
Cx IF ALREADY PAST OUTPUT POINT DURING A SUBSEQUENT CALL,THEN INTER- * 1980 


C* POLATE AND RETURN * 1999 
CR& RKKKEKRKARKRERERRRREREREREREERRRRKERERRRERRRRRERERERERERRRKRRERREKRERERKE 2000 
IF (INFO(1).EQ.@.OR.X.LT.XE) GOTO 1¢ 2016 
CALL INTER2(N, Y,Y1,Y2, YXE, (X-XE) /H) 2626 
RETURN 2030 


CRE ARKKRK KK ERA RK RRR RR REE RR ERER ER RR ERER RE RERERRRERRRRERERRRERRRERRRERRER ~—-2QAG 


C* SET THE ERROR FLAG IFLAG EQUAL TO ZERO AND INITIALIZE APR.DETERMINE * 205 
C* THE MAXIMAL DEGREES WITH RESPECT TO INTERNAL STABILITY.IF NECESSARY * 296@ 


c* INTERRUPT * 2076 
CHR RKAEKKEREKRKEKRER RR RKERREREREERER EK REREERRRERER EER RRR RE RERRRRRERRERERKERERER 2080 
1@ IFLAG=@ 2690 
APR=1. @E-14 21060 

CALL MAXDEG (TOL, APR, IFLAG, INFO) 2110 
IF(IFLAG.NE.2) GOTO 26 2120 

RETURN 213¢ 


CHK RAKAAKKARKEKAKK AK RRR AR ARER RK RRR RR ERE ER RRR RR ERE RRR ERE RERERERRRERERER = 2140 
Cx SET THE CONTROL VARIABLES INFO(9),REJECT AND HOLD FOR A CONTINUING * 2150 


C* CALL,AND INITIALIZE THE ARRAY HMAX * 2160 
CRA RRRAKREKRERERKRKRKRKRRRRERERE RR RERKEKRERERERRRRRREERKRERER ERE RRRARERERERE 217¢ 
20 INFO(9)=@ 2180 

IF (INFO(1).EQ.@) GOTO 3@ 2190 
REJECT=0 2200 

HOLD=H 2210 
HMAX(1)=5. 15*FLOAT (INFO(1@)) *FLOAT (INFO(1@)) /SIGMA(1) 2220 

HMAX (2)=2. 29*FLOAT (INFO(11)) *FLOAT (INFO(11)) /SIGMA(1) 2230 

GOTO 80 2240 


CER RAKKEKKKRKERKKKERERERKEERRRERERERER ERE ER RRR ERRERERERRRRRRERERRRRRRERKR 2256 


C* SET REJECT,HOLD AND H FOR THE FIRST CALL. SET THE ELEMENTS INFO(I), * 2260 
C* I=4,...,8,13,14,15 EQUAL TO ZERO AND INFO(12) EQUAL TO 2.TO PREPARE * 2279 
C* THE FIRST STEP EVALUATE F(Y) AND SUBSTITUTE INTO DY.IF NECESSARY * 2286 
Cx ESTIMATE THE SPECTRAL RADIUS AND CHECK FOR A FAILURE OF THE POWER * 2290 
* 


C* METHOD. INITIALIZE ARRAY HMAX AND ESTIMATE THE INITIAL STEPLENGTH 2300 
CHA KAKA AKA AK RKKK KK REKEK ER ERER RK ER ER ER KERR ERK RR RK RK REE ER RER ERK ERERERREERER 23:10 


3@ INFO(1)=1 2320 
REJECT=0 2336 
DO 40 1=4,8 2340 
46 INFO(1)=@ 2350 
DO 5@ I=13,15 2360 
5@ INFO(I)=0¢ 2370 
INFO (12)=2 2380 


DO 6@ I=1,N 2390 
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DY(1L)=Y(1) 2400 
DY1(1)=¢. 2410 
Y1(1)=@. 2420 
Y2(1)=0. 2436 

6@ CONTINUE 2440 
CALL F(N,DY) 2450 
INFO(7)=INFO(7)+1 2460 
IF(INFO(2).EQ.1) GOTO 7¢ 2470 
SIGMA(1)=@. 2480 
CALL POWERM(N,Y, Y1,YXE, DY,DY1, F, SIGMA, APR, IFLAG, INFO) 2490 
IF(LFLAG.NE.3) GOTO 7@ 2500 
RETURN 251 

Cc 2520 
70 HMAX(1)=5. 15*FLOAT (INFO (1@)) *FLOAT (INFO(10)) /SIGMA(1) 2530 
HMAX (2)=2. 29*FLOAT (INFO(11)) *FLOAT(INFO(11))/SIGMA(1) 2546 
CALL HSTART(N, Y, DY, YXE,F,TOL,APR,SIGMA(1),HMIN, INFO) 2550 
H=HMIN 2560 
HOLD=H 2570 


CHEKKK KK KKKKKAERRKK RK ERE RK KEK KEK KR RK RR ER REK AK KERR KR KIRK RK ERE EEK RRKREKKRER 25.88 
C* DETERMINE THE DEGREE, AND, IF NECESSARY,CALCULATE “HE PARAMETERS OF * 25906 


C* THE SCHEME TO BE USED * 2600 
CREREREKKERKKRKERRKRERERERERERERREREKERERERKREERERREKRREREKRRRREERRERRRERRKE 2610 
8@ MOLD=INFO(9) 2620 
CALL MINDEG(H, SIGMA(1), INFO) 2630 

IF (INFO(9).EQ.MOLD) GOTO 9@ 264 

CALL PARAM(C, LA, B, INFO) 2656 


CRARKAKAKE RAR AREER RRER ER AK ARK RE RK RK EKER ER ERR ER ERK KE RURKR EERE RRERERERERERE = 2660 
C* CHECK IF THE MAXIMUM NUMBER OF EVALUATIONS IS REACHED.UPDATE HMIN * 2670 


Cx AND CALCULATE A SOLUTION AT X+H * 26806 
CRHEKKARKRKEKKEKERERRKREKRREKRRRKEREERRRKRRRERRREREREERRRERRERERERRKREREERRKEEKE 269¢ 
9@ IF(INFO(7).GE.INFO(3)) IFLAG=1 2700 
IF(LFLAG.NE.1) GOTO 1606 2716 
RETURN 2720 

C 2730 
10@ IF(H.LT.HMIN) HMIN=H 2740 
CALL STEP(N,Y,Y1,Y2, YXE, DY,DY1,H,F,C,LA,B, INFO) 2750 

INFO (13)=INFO(13)+1 2760 

INFO (4)=INFO (4)+1 2770 


CREKKRARKERAKR KK ERK RERERERERERERERERERRR KERR RERRERRRRRKERERERRRERRRERERERE 2780 


C* IF THE PROCESS IS IN THE START PHASE,SHIFT THE DATA.CHECK FOR THE * 2796 
C* CONTINUATION WITH A THREE-STEP SCHEME.IF THE OUTPUT POINT IS PASSED * 2806¢ 


C* INTERPOLATE AND RETURN * 2810 
CAERKRKKKKRKRERERRERE RRR RR RERK RE EKER RERERERERERRRERERKERERE KERR RRERRERERER 2820 
IF(INFO(13).GE.3) GOTO 11¢ 2830 

CALL SHIFT(N,Y,Y1, Y2, YXE,DY,DY1, X,HOLD,F, INFO) 2840 
INFO(14)=INFO(14)+1 2850 
INFO(15)=INFO(15)+1 2860 

LF (INFO(13).EQ.1) GOTO 9¢ 2870 

INFO (9)=0@ 2880 
IF(X.LT.XE) GOTO 8@ 289¢ 

CALL INTER2(N,Y,Y1,Y2, YXE, (X-XE) /HOLD) 2960 
RETURN 291¢ 
CHAREKKKKRKRAKRKRERKAR EKER RE REE RR AREER REE KRERRERERERRERERRERERERRERERRERRRREA 2920 
Cx CALCULATE THE LOCAL ERRORBOUND AND ESTIMATE THE LOCAL ERROR. k 2930 
CERKRRERKKKRKEKERERKRREKERKRRRREKRKERREKREKRKERRRERERERRERRURERERRERERERRRRRREEK 2940 
11@ CALL ESTIMA(N,Y, Y1, Y2, YXE, TOL, EPS, ERROR, INFO) ‘ 2950 


CH RRKAKK IK KKAK RR EKER KKK KKK EK AK RK RK RK ERK ER RRR RR RRR RRR RRR RERERRERERERER 2960 
C* IF THE ERROR IS TOO LARGE FOR THE THIRD STEP AFTER START,THEN RE- * 2970 


C* START AT INITIAL POINT WITH H=H/10 * 2980 
CRERKRKKRKEKEKKAKRKRKKERE RK RERKRKERKRERERERERKERERRERREERRERERERRRERRERKEEREKE 2996 
IF (EPS .GE.ERROR.OR.INFO(13).NE.3) GOTO 130 3000 

INFO (6)=INFO(6)+1 3610 

INFO (5)=INFO(5)+3 3620 

INFO (9)=@ 3030 
INFO(13)=@ 3040 
INFO(14)=0 3650 
INFO(15)=0 3660 

X=X- 2. *H 3070 
H=H/1@. 3080 
HOLD=H 3090 

DO 1206 I=1,N 31060 
Y¥(1)=¥2(1) 3119 
DY(1)=Y(1) 3120 

12@ CONTINUE 3130 
CALL F(N,DY) 3140 


INFO (7)=INFO(7)+1 3150 
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GOTO 8¢@ 3166 
CARAKARKEKKKKK RR REKRERERRRRER ERE RRR ARERRREKRERRER RRR RKRERERERERRRKERRRERE 3170 


C* IF STEP FAILED,CHECK FOR A REESTIMATION OF THE SPECTRAL RADIUS.IF * 3180 


C* NECESSARY, CHECK FOR A FAILURE OF POWERM AND UPDATE HMAX k 31906 
CREEK RARAAKKERERKEAE KERR RR EERE RRERRRK ER ER ERRE RERERR RRR RRRRER RE REKRERERERRR 3260 
13@ IF(INFO(2).EQ.1.OR.INFO(15).EQ.@.OR.EPS.GE.ERROR) GOTO 15¢ 321¢ 
SIGMA(1)=@. 3226 

CALL POWERM(N,Y,Y1,YXE, DY, DY1, F, SIGMA, APR, IFLAG, INFO) 3230 
IF(IFLAG.NE.3) GOTO 1406 3240 
RETURN 3250 

C 3260 
14@ HMAX(1)=5. 15*FLOAT (INFO(10)) *FLOAT (INFO(1@)) /SIGMA(1) 3270 
HMAX (2)=2. 29*FLOAT (INFO(11)) *FLOAT (INFO(11)) /SIGMA(1) 3280 
CERKKRKRKRRKKEKRKRERA RK RRR RERKKKERER ER ERERR RRR ERRRRRERERRRERERERERREEREERER 3290 
C* CALCULATE A NEW STEPLENGTH * 33¢6¢ 
CRAEKAKKKKKAKER AKER RK RE RE RKKK RRR ERR RK RRR ER KER RRERERRERERR RRR RRRRERERERK 331¢ 
15@ HOLD=H 3326 
CALL NEWH(EPS/ERROR, HOLD,H, ALFA, HMAX, INFO) 3330 


CRERAKAKAKAKAAKAKKK RE RRR ERK RRKK ER RRR RE REE K AK RRR KAR RE RRRRERKEREREREREERER — 33340 
C* IF THE ORDER EQUALS 1 AND THE STEPLENGTH IS SMALLER THAN THE MAXI- * 335@ 


C* MAL STEPLENGTH FOR ORDER 2 RESET THE ORDER * 3360 
CHAK KK KR AK KK RAKE RK ERR KEKRRRRRK RR RR RR REAR RRR RRR BERR ERERERERERERRRERERER 33370 
IF (INFO(12).EQ.1.AND.H.LT.HMAX(2)) INFO(9)=@ 3380 
IF(INFO(9) .EQ.@) INFO(12)=2 3390 


CHAR RKARKK RIKER KEK RK RR RK ARERR RRR KARR RER ERK RRR ERERRRERRRERERRERRERER 33400 
cx IF STEP FAILED REJECT THE INTEGRATION STEP.CHECK FOR THREE SUCCES- * 3410 


C* SIVE FAILURES,AND,IF NECESSARY, INTERPOLATE FOR THE NEW STEPLENGTH * 342 
CH KERR KAAKKAAK KKK KKK AKER EK RE RR RR ER ER ERR EKA ERE ERERER EER RRRERRERER 3343 


IF(EPS.GE.ERROR) GOTO 17@ 3446 
REJECT=REJECT+1 3450 

INFO (5)=INFO(5)+1 3460 
LF(REJECT.EQ.3) GOTO 16@ 3470 

CALL INTER1(N,Y,Y1,Y2, DY1,F, ALFA, INFO) 3480 

GOTO 86 3490 
CHRAKAKKKKKRKRRE RE ERERERERRERRERERERRERE ER ERE RRR ERE ER RERRRR RRR RE RRERRRRR 3506 
C* RESET REJECT, INFO(1), I=6,9,12,13,14 AND THE STEPLENGTH FOR A * 3510 
C* RESTART * 3520 
CRERKKARKAKKKRERKR RK RRR RR RERERERERRE REE ER ER RIEER ER RRR RR RRREIRERERRERRRRRRA 3536 
16@ REJECT=0 3540 
INFO (6)=INFO (6)+1 355 

INFO (9)=@ 3560 
INFO(12)=2 3576 

INFO (13) =0 3586 

INFO (14) = 3599 

CALL HSTART(N,Y,DY,YXE,F,TOL, APR, SIGMA(1),H, INFO) 3600 
HOLD=H 36106 

GOTO 8¢@ 3620 
CHAERKKRRAKEKAREKE REE RKRREKRERRERKRRERERER RRR RERERRR RR RRR RRR ERR RRR RRR 3630 
c* FIND OUT IF THE ORDER SHOULD CHANGE FROM 2 TO 1.ON EXIT OF THIS * 364¢ 
C* PROGRAM PART H SHOULD BE RESET TO HMAX(2).IF THE ORDER HAS TO BE * 3650 
C* CHANGED FROM 2 TO 1 SET INFO(9)=¢ * 3666 
CARKAKKKKEKKKEREKRERARERER RR ERER ER RR RRR RRR RRRER ER ER RR ERERR RRR RERRRRRRR RRIR 367¢ 
170 IFCINFO(14).LT.3.0R.INFO(12).EQ.1) GOTO 18¢ 3680 
IF (HOLD.NE.HMAX(2) .OR.H.NE.HMAX(2)) GOTO 18 3690 
INFO(12)=1 3700 

CALL ESTIMA(N,Y,Y1,Y2, YXE, TOL, EPS, ERROR, INFO) 3716 

CALL NEWH(EPS/ERROR, HOLD, H, ALFA, HMAX, INFO) 3720 
IF(ALFA.LE.1.) INFO(12)=2 3730 
H=HMAX (2) 3740 
INFO(14)=+1 375@ 
IF(INFO(12).EQ.2) GOTO 18¢@ 3760 

INFO (9)=@ 3770 
CRRRRRER KK RK ER KK KR ER KER ER RRR KKK EEK RR EERE ERR RR KERR IR RRR ARR RIK IARI II 3786 
C* SHIFT THE DATA * 3796 
CHAR KKRK RK RARE RK RRR ER EKER EKER ER RR RKER ERE RERERRE RR ER ER RRR ERE REIKI RIA 3860 
189 CALL SHIFT(N,Y,Y1,Y2,YXE,DY,DY1, X,HOLD,F, INFO) 3819 
REJECT=@ 3820 

INFO (14) =INFO(14)+1 3830 

INFO (15)=INFO(15)+1 3846 


CHRRRR ER AKER RR RR RARER KKK KEK RR ERR RRERREKKK RR EKER EEK ERE RERRERKRRERERERER 3859 
C* CHECK FOR A REESTIMATION OF THE SPECTRAL RADIUS.IF NECESSARY,CHECK * 3860 


C* FOR A FAILURE OF POWERM AND UPDATE HMAX * 38706 
CHEESE a SS IGS CE I ITA S IIIS SEI da O HORE beni abiibibiciisaiers 3880 
IF (INFO(2).EQ.1.OR.INFO(15).NE.25) GOTO 26 3899 
CALL POWERM(N, Y,Y1,YXE,DY,DY1,F,SIGMA, APR, IFLAG, INFO) 3960 


IF (IFLAG.NE.3) GOTO 19¢ 3916 
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RETURN 3920 

Cc 3930 
19@ HMAX(1)=5.15*FLOAT (INFO(1@) ) *FLOAT (INFO(1@)) /SIGMA(1) 3940 
HMAX (2)=2. 29*FLOAT (INFO(11)) *FLOAT(INFO(11))/SIGMA(1) 3950 


CHREKKKRKEKK AK AKER EK RK KER ARER RR KERR ER ARERR RK IERERREE ER EREREREREREREREERE = 3960 
c* IF X IS SMALLER THAN XE CONTINUE THE INTEGRATION.IF NECESSARY, IN- * 3970 


Ck TERPOLATE FOR A CHANGE OF H k 3986 
CRERKRKKEREREERERRERERERERERERERRER EERE ERRERERERERERERERRRERRRERERERRRERK 3996 
20@ IF(X.GE.XE) GOTO 21¢ 4000 
IF(H.NE.HOLD) CALL INTER1(N,Y,Y1,Y2,DY1,F,ALFA, INFO) 4010 

IF (H.NE.HOLD. OR. INFO(9).EQ.@) GOTO 80 4620 

GOTO 9¢ 4936 


CRAEKKRKAKKRERKKK RK AKKK KKK RAK KK KKK KKK KKK KKK RK EK KER EKRRE RERE RK ERKERKKEREREKE —AGGG 
C* INTERPOLATE AT XE AND,IF NECESSARY, INTERPOLATE FOR A CHANGE OF H x 4050 


C* BEFORE RETURN * 4660 
CRARKKRERERERKRERKERRERERKRRRKERERERERRRERERERERKERREKRRERRERERERRREKKRRAKER 4076 
21@ CALL INTER2(N,Y,Y1,Y2, YXE, (X~-XE) /HOLD) 468 
IF(H.NE.HOLD) CALL INTER1(N,Y,Y1,Y2, DY1, F, ALFA, INFO) 4990 
RETURN 4106 

END 4110 
SUBROUTINE HSTART(N,Y,DY,YXE,F,TOL,APR, SIGMA, H, INFO) 4120 
CRERKRKRRERERKAEKRKREKKERKRKKKRERERRERERKEKRERERRERERERER REE RRRERRRRRERERRRKERER 4130 
cC* SUBROUTINE HSTART CALCULATES THE INITIAL STEPLENGTH * 4146 
CRAEKKERERERERKRRERERRKRKREKEKEERRRERRRRRRERRERRK REE RRERRRRRRERERRRRRRRERRERE 415@ 
DIMENSION Y(N),DY(N) ,YXE(N) , INFO(15) 4160 

DO 1@ I=1,N 4170 
YXE(1I)=Y (1)+DY(1I)/SIGMA 4180 

1@ CONTINUE 4190 
CALL F(N,YXE) 4200 

INFO (7)=INFO(7)+1 4219 
ETAT=0.@ 4220 
ETAE=6.¢@ 4230 

DO 2¢ I=1,N 4246 
ETAT=ETATHY (1) *Y (1) 4250 
E=YXE(1I)-DY(1) 4260 
ETAE=ETAE+E*E 427 

2@ CONTINUE 4280 
ETAT=TOL+TOL*SQRT (ETAT/ FLOAT (N) ) 4290 
ETAE=SQRT (ETAE/ FLOAT (N) ) /SIGMA+APR 4360 
H=SQRT (ETAT/ETAE) /SIGMA/1@.¢@ 4310 

e 4320 
RMMAX= INFO (11) 4330 
BETA=(@. @3*RMMAX+@. 44) *RMMAX*RMMAX 4340 

LF (H.GT.BETA/SIGMA)H=BETA/ SIGMA 4350 
RETURN 4360 

END 437 
SUBROUTINE PARAM(C,LA,B, INFO) 438 


CREKEKKERERKRKKERKRRKRKRRRERERERKRERERERKERKEKKEERRRKEE RR ERERERKEREERRRERKE 4396 


C* PARAM DETERMINES THE PARAMETERS OF THE INTEGRATION SCHEME. THESE * 44060 
C* PARAMETERS ARE EXPRESSIONS DEPENDING ON THE COEFFICIENTS OF THE x 4410 
Ck STABILITY POLYNOMIALS,WHICH ARE STORED IN THE ARRAY D. DURING * 4426 
CX THE START,I.E.INFO(13) IS @ OR 1,THE PARAMETERS OF A ONE-STEP SCHE- * 4436 
x 


c* ME ARE DETERMINED. 4440 
CREAKKRRERREK RRR ER ERK EKER ER ER ER RRR RE RK RRRER ER ERE RE RRERERERRRERRERKEEK ASG 


REAL LA 4460 

DIMENSION C(12),LA(12),B(2),D(44@) ,P(13) ,8 (13), INFO(15) 4470 

INTEGER ORDER 4480 

DATA D(1),D(2),D(3),D(4) ,D(5),D(6),D(7) ,D(8) ,D(9),D(10), 449 
+D(11),D(12) ,D(13),D(14),D(15) ,D(16) ,D(17) ,D(18) ,D(19) ,D( 20), 4500 
+D(21),D(22),D(23),D(24),D(25) ,D( 26) ,D(27) ,D(28) ,D(29) ,D(3@)/ 4510 
+.54545454545454E+0O, . 32974222139503E+0O, .1587454096372GE-O1, 4520 
+.54545454545454E+00, . 32957779372404E+ OO, .18807742712872E-O1, 4530 
+. 2693140629566 8E-@3, .54545454545454E+GO, . 32959633626966E+O0, 4540 
+.19843848141588E-@1, . 383705169 74646E-@3, .232140668199836E-@5, 455@ 
+.54545454545454E+0Q, . 32940480780399E+O0, . 2028956229 74884E-O1, 4566 
+.43922728369494E-03, . 38881393659 393E-@5, .12658533806519E-@7, 4576 
+.54545454545454E+GO, .32915730747582E+0O, .20529934599533E-O1, 4580 
+.47901456507018@E-03, .48729959290595E-05, .23293337843875E-07, 4596 
+.41768893290961E-10, .54545454545454E+O0, . 32940296556199E+O0, 4600 
+.20695785946957E-@1, . 48959 30520827 7E-@3, -55250561672575E-@5/ 4616 

DATA D(31),D(32),D(33),D(34),D(35) ,D( 36) ,D(37) ,D(38) ,D(39), 4620 


+D(40),D(41),D(42),D(43),D( 44) ,D( 45) ,D(46) ,D(47) ,D( 48) ,D(49), 4630 
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+D(56),D(51),D(52), D(53),D(54),D(55),D(56),D( 57) ,D(58),D(59), 
+D (60) / 


t++etee gets 


-32042572866540E-67, 
-54545454545454E+O9, . 
- 5014487 3108237E-03, 
-13735161731261E-@9, 
-54545454545454E+ 60, 
- 51019371265 378E-@3, 
- 1755795662208 3E-69, 
- 281623966239@2E-18, 
- 2084770989177 3E-@1, 
-4669468155356QE-07, 


-92217187087773E-10, 
32904622047855E+00, 
- 5953831249849 3E-5, 
-25579038177072E-12, 
. 329902403825404E+00, 
.62671263848834E-65, 
-415299099936815E-12, 
-54545454545454E+OO, 
-51474622625718E-63, 
-20545752812528E-09, 


.16431596770258E-12, 
.20769127247467E-@1, 
. 384136 39404624E-@7, 
.1935532554926@E-15, 
. 20835887364795E-01, 
.43273294211670E-07, 
-5297776063801@E-15, 
- 3290070177052 3E+00, 
-64655444450446E-65, 
-55985683650846E-12/ 


DATA D(61),D(62),D(63) ,D(64),D(65),D(66),D(67) ,D(68) ,D(69), 
+D(70),D(71),D(72) ,D(73) ,D(74) sD(75) ,D( 76) ,D(77) ,D(78) ,D(79) , 
+D(80),D(81),D(82),D(83),D( 84) ,D(85),D( 86) ,D(87) ,D(88) ,D(89), 
+D(96)/ 


t+teteeteest 


-92238949881933E-15, 
-54545454545454E+ 00, 
-52155114179973E-@3, 
- 2317519907303 2E-99, 
-15876152476718E-17, 
-54545454545454E+ 60, 
- 5239804836993 7E-63, 
-25160762750795E-09, 
-24963258323529E-17, 
+ 24672233557657E-27, 


-84171480799272E-18, 


»32655765072494E-21, 


- 32923047518706E+OO, .2094216551445G6E-@1, 


- 666984932295Q1E-O5, . 
.13309584971259E-14, 
. 31159779644428E-24, 
. 209 30564082556E-61, 
. 5189226 3386503E-07, 
.17105594522426E-14, 
. 1100273956954GE-23, 
- 39753050587 769E+00/ 


-69290153772379E-12, 
- 1070279440696 32E-20, 
-32888824622955E+00, 
-67865318951772E-65, 
- 80319 349635922E-12, 
-21467888957759E-20, 
-45454545454545E+O0, 


49787290971999E-0@7, 


DATA D(91),D(92),D(93) ,D(94) ,D(95) ,D(96) ,D(97) ,D(98) ,D(99) , 
+D( 100) ,D(101) ,D(162) ,D(163) , D( 164) ,D(105) ,D( 16) ,D(107), 
+D (108) ,D(109),D(110) ,D(111),D(112) ,D(113) ,D(114) ,D(115), 
+D(116),D(117),D(118) ,D(119), D( 120) / 


++t+eet+et¢¢+ 


- 191060342 36683E-¢1, 
- 226751009 22608E-@1, 
-39767639190306E+O0, 
«279454925 39 796E-65, 
- 24509754044 86 7E-@1, 
-14585303356181E-@7, 
-24864589588956E-@1, 
- 283006089 26 316E-@7, 
- 3978698217167 3E+ G9, 
-66757562996758E-O5, . 387204689647 7GE-@7, . 


+45454545454545E+O6O, 
- 32438614977749E-63, 
-23921246939481E-@1, 
+ 45454545454545E+ 00, 
- 5307184 8010798E-63, 


-56998860293388E-63, 
- 5981259 8486162E-10, 
-25000002282553E-@1, 


- 39769493354868E+O0, 
+©45454545454545E+ 00," 
«4622133454575 8E-63, 
-39786791946874E+06, 
- 4790025894002 75E-65, 
-45454545454545E+0O9, . 


398115419 79691E+69, 


-5913834060351Q0E-05, 
-45454545454545E+ 00, 
-59148858437864E-63, 


1114476116 3396E-69/ 


DATA D(121),D(122) ,D(123) ,D(124) ,D(125) ,D(126) ,D(127), 
+D( 128) ,D(129) ,D( 130) ,D(131),D(132) ,D(133) ,D( 134) ,D(135), 
+D (136) ,D(137),D(138),D(139),D(14@) ,D(141),D(142) ,D(143), 
+D(144) ,D(145),D( 146) ,D(147) ,D( 148) ,D(149) ,D(150)/ 


+eettteett 


-126081537280@0E-12, 
-25183525013803E-61, 
-46725317100106E-067, 
-2359037048211GE-15, 
«25265819897 76 7E-@1, 
-52536344101559E-@7, 
-643176885 39928E-15, 
- 39826570956 75GE+00, 
- 7854062969 3845GE-65, 
-68066567167935E-12, 


-45454545454545E+@9O, . 
-69880314613113E-@3,. 


. 167195945035@1E-09, 
-45454545454545E+00, 
-61910411544859E-63, 
. 21317642667569E-09, 
-34187163161474E-18, 
. 25287844091655E-@1, 
- 567431514 56468E-07, 
.11216260688042E-14, 


3982265067941 7E+OO, 
72358433614328E-65, 


.31157527742621E-12, 
- 39824868901 869E+00, 
. 7607471114885GE-05, 
-50421345500406E-12, 
-45454545454545E+ OO, 
-62494425734623E-63, 
. 24973869169 769E-09, 
. 102368029 78533E-17/ 


DATA D(151),D(152) ,D(153),D( 154) ,D(155) ,D(156) ,D(157), 
+D(158) ,D(159),D(160),D(161) ,D(162) ,D(163), D( 164) ,D(165), 
+D(166) ,D(167),D(168) ,D(169) ,D( 176) ,D(171) ,D(172) ,D(173), 
+D(174) ,D(175),D(176)/ 


t+tt+t¢etti+ 


- 3972065 7964596E-21, 
-25341708658167E-@1, 
-60354664492269E-07, 
.16167280397671E-14, 
3794445 3664 70GE-24, 
+ 25416762495946E-@1, 
-63149729888770E-@7, 
-20836563130596E-14, 
. 13415328284 784E-23, 
DATA D(177),D(178) ,D(179), D(180) ,D(181) ,D(182) ,D( 183) ,D(184), 

+D(185) ,D(186) ,D( 187) ,D(188) ,D( 189) ,D(19) ,D(191) ,D(192) ,D( 193), 
+D(194) ,D(195),D(196) ,D(197),D(198) ,D(199) ,D( 260) ,D( 261) ,D( 202), 


-45454545454545E+00, 
.63151501325496E-03, 


-28111642092611E-99, 


.192999417899Q7E-17, 
-45454545454545E+ OO, 
- 63697712076076E-@3, 


- 29320679574331E-17, 
- 3009279619622 3E-27/ 


+D (203) ,D(2064), D( 205) ,D(206)/ 


+-.58064516129032E+00,-.21559395174672E+0O, —. 30544696579492E-G1, 
+ 58064516129032E+00,-.19115223031554E+@O, —.29473834786102E-01, 
- 1906634725 8135E-@2, -.58064516129632E+0O, -.182333067297138E+0O, 
- 2823654447 3632E-@1, —. 126300396012 32E--G2, -.15268008334815E-04, 
-58064516129032E+@O, -.17833069941496E+G0, -.28475246894827E-O1, 


+. 
+ 
+ 
+- 


- 3980422520856 7E+0O, 
-86807554649258E-65, 
- 8410633463865 7E-12, 
- 13021732956413E-20, 
- 398384481064 318E+00, 
- 825519835082 28E-65, 
- 30629858708888E-99, . 


9780868191644GE-12, 


- 2616649 7617204E-2¢, 


553-P13- 


0 


COLLECTED ALGORITHMS (cont.) 


- 146963620304 82E-92, -.2996411136460@E-O4, —. 21343864115613E-G6, 
-58664516129032E+0O , — .1761036 7098315E+OO, —. 2826067664509GE-G1, 


- 15322458816336E-02,-.36586320114212E-@4,-. 


39867529427935E-66, 


- 16226665135199E-98 ,— .58964516129932E+09, —. 1748339011491 1E+O0, 


- 27741186226246E-@1 , —. 1481595698991 8E-G2,-. 


36 301045393729E-@4/ 


DATA D(2067),D( 208) ,D( 209) ,D( 210) ,D(211) ,D( 212) ,D(213) ,D(214), 
+D(215) ,D(216),D(217) ,D(218),D( 219) ,D(22@) ,D( 221) ,D(222) ,D(223), 
+D(224) ,D( 225), D( 226) ,D( 227) ,D( 228) ,D(229) ,D(23@) ,D(231) ,D( 232), 
+D( 233) ,D( 234) ,D(235),D(236)/ 


+-. 


- 446850075507 78E-06,- .26875584507281E-68, -. 
— .17396071288671E+@¢, -. 
- . 5084586909299 3E-04,-. 
~ . 29589 252318632E-19, -. 
—.17339878373842E+60, -. 
—.45816065724231E-04,-. 
—.33259355915939E-19, -. 
— .58964516129932E+O9, -. 
~ .16157222373633E-@2,-. 


-58064516129632E+00, 
-17432495919146E-62, 
-67374753547729E-@8, 
- 58964516129632E+O0, 
- 16253143532453E-@2, 
-6494907274814GE-68, 
- 19625147968957E-15, 
- 28915092938518E-@1, 
» 75479222345544E-66, 


- 17960137796770E-12, 
-58064516129932E+@¢, 
. 15056021545051E-@2, 
-65536146317341E-68, 
- 45 36 849068209 98E-15, 


. 1274593569 2238E-@7, 


- 152189641365 28E-14, 


- 58064516129032E+O0, 
- 185961744364 26E-@2, 


628312319083352E-11, 
28684134226593E-@1, 
79137773126678E-@6, 
5241629406 35@7E-13, 
28044727272007E-@1, 
711557880603856E-@6, 
92392278190522E-13, 
1714417337 7009E+60, 
46227724829057E-04, 


- .74894835017511E-@8, -. 459799535 35837E-10/ 
DATA D(237),D(238) ,D(239),D( 249) ,D(241) ,D( 242) ,D(243) ,D( 244), 
+D(245),D(246),D(247) ,D(248) ,D( 249) ,D(25¢) ,D( 251) ,D(252) ,D(253), 
+D(254) ,D(255), D( 256) ,D(257),D( 258) ,D(259) ,D( 260) ,D(261) ,D( 262), 
+D (263) ,D(264) ,D(265),D(266)/ 


— . 3595666 308659 7E-15,-. 
~ .17300284166294E+G9, -. 
-.41367453292114E-@4,-. 
-—.42991025159364E-19,-. 
~ .66928703208412E-18,-. 
-.17229366966984E+0¢, -. 
-.599769787309G6E-04,-. 
-.95158694657869E-16,-. 
—.31130952108508E-17,-.. 
186449343681 93E-23, .15806451612993E+@1, . 15¢59165323919E+01/ 


30628886618191E-18, 
2732890909024214E-O1, 
65884289 780074E-@6, 
17479977056317E-12, 
42844311155752E-21, 
28800272381574E-@1, 
11999566945359E-65, 
469694964769 75E-12, 
56466961532119E-20, 


DATA D(267),D( 268) ,D(269),D(270) ,D(271) ,D(272) ,D(273) ,D(274), 
+D (275) ,D(276),D(277) ,D(278) ,D(279) ,D( 280) ,D( 281) ,D( 282) ,D(283) , 
+D(284) ,D(285) ,D( 286) ,D(287) ,D( 288) ,D(289) ,D(29@) ,D(291) ,D( 292), 


+ 


++ttt+tet 


$ 


147265565 36165E+@1, 
-11558@84587197E-@3, 
- 2049832571572 8E+GO, 
-13919261448922E-65, 
-20699571533935E+@O, 
-26855639111666E-65, 
1465156481794 3E+@1, 
«27524 368830002E-63, . 


19316031414 798E+@¢, 


4689392 52243194233) » 
.62334163398843E-02, 
. 20074218117966E+00, 
.15806451612963E+@1, 
.99938118863291E-@2, 
.15806451612903E+@1, 
. 19680275405545E-@1, 
. 19854850713601E-07, 
- 207745994 75456E+00, 


6390251612903E+01, . 


354036569 3442 3E-@5, . 


14814748109667E+@1, 


. 158¢64516129963E+@1, 
. 863369 766 30508E-02, 
- 14686532800601E+01, 
.19922348036296E-63, 
-14664262516283E+@1, 
- 2493340506726 3E-63, 
-15806451612903E+@1, 
. 19971861052267E-61, 


22575 321236761E-07/ 


DATA D(297),D(298) ,D(299) ,D( 300) ,D(301) ,D( 362) ,D( 303) ,D(304), 
+D (305) ,D(306) ,D(307) ,D( 368) ,D( 309) ,D( 310) ,D(311) ,D(312) ,D(313), 
+D(314) ,D(315),D(316),D(317) ,D( 318) ,D(319) ,D( 320) ,D(321),D(322), 
+D (323) ,D(324),D(325) ,D(326)/ 


t+ ttteetts+ 


-56574487882585E-19,. 
- 20956213101 730E+00, 
- 456369861 33 302E-65, 
- 269 33430035588E-12, 
-2909484653211G1E+OO, 
-49116729047009E-65, 
-66879118493869E-12, 
-14617643144152E+@1, 
- 33440743994479E-@3, 
- 33075450191903E-9, 


.11509566107375E-@1, 
- 37079641130883E-67, 
-158964516129903E+G1, 
-11536416747709E-@1, 
-44528196080481E-@7, 
-79239438466385E-15, 
- 21141206884584E+¢¢, 
-54414235293880E-65, 
-12264057386754E-11,. 


15806451612903E+@1,. 


14642832935319E+0@1, 


. 3109798816382 8E-63, 
. 15682590950194E-09, 
- 14637213643836E+@1, 
«3178461487054 8E-@3, 
. 2350532833139 3E-09, 
- 15806451612903E+G1, 
-118950562880624E-G1, 
- 539186864 34111E-07, 


25181064036724E-14/ 


DATA D(327),D(328) ,D(329) ,D( 330) ,D(331) ,D( 332) ,D(333) ,D(334), 
+D(335) ,D (336) ,D(337),D(338),D( 339) ,D(340) ,D(341) ,D( 342) ,D(343), 
+D(344) ,D(345),D(346),D( 347) ,D( 348) ,D(349) ,D(35@),D( 351) ,D(352)/ 


+++ ttettest 


DATA D(353) ,D(354),D(355),D( 356) ,D(357),D( 358) ,D(359) ,D(360), 
+D(361) ,D(362),D( 363) ,D(364),D(365) ,D( 366) ,D(367) ,D(368) ,D( 369), 


-2197761607281@E-17,. 
- 2091638770386 9E+GG, 
- 54458388015 784E-65, 
-166919659596325E-11, 
-421484579 241G5E-2@, 
-21134531244915E+0¢, 
-62664422624671E-65, 
»24253292036317E-11, 
-18192819599155E-19,. 


-1157945455@239E-@1, 
-56371977519294E-@7, 
- 42884 398776166E-14, 
- 15896451612903E+@1, 
-12108121568554E-@1, 
-69193362616297E-@7, 
-77316365461803E-14, 


158964516129963E+¢@1, 


9177610747672 7E-23/ 


-14633254223¢81E+@1, 
- 3285 739055290G8E-63, 
- 3754508369 244GE-9 , 
-64665832685414E-17, 
-14626162502550E+O1, 
-35894153745450E-63, 
-50195179261835E-09, 
-15615921810526E-16, 


553-P14- 


0 


COLLECTED ALGORITHMS (cont.) 


+D (3706) ,D(371),D( 372) ,D(373), D( 374) ,D( 375) ,D( 376) ,D( 377) ,D(378) , 
+D (379) ,D( 380), D( 381) ,D(382),D( 383) ,D(384) ,D( 385) ,D( 386) ,D( 387), 
+D( 388) ,D(389),D( 390) ,D( 391), D( 392) ,D( 393) ,D( 394) ,D(395) ,D(396), 
+D(397),D(398), D( 399) ,D(400) ,D€401) ,D(4@2)/ 

+1.,1.,.-5; 

+1.,1.,0.5, 63304085.E-09,1.,1.,0.5, 79027358.E-@9, 37089254.E-10, 
+1.,1.,@.5, 85605575.E-@9, 56773923. E-10, 12758716.E-11,1.,1.,@.5, 
+8901 8496 .E-@9, 6794 7603. E-16, 23143226. E-11, 2898388.E-12,1.,1.,0.5, 
+91625468.E-09, 74822425 .E-10, 36567580. E-11, 60720@1.E-12, 

+4679 323. E-14,1.,1.,0.5,92308224. E-@9, 79335426. E-1, 35849723.E-11, 
+8800161.E-12, 11108474. E~14, 5648779.E-16,1.,1.,@.5, 93178948.E-@9, 
+82451157.E-10, 39680345. E-11, 110003@61.E-12,17552367.E-14/ 

DATA D(4@3),D(404),D( 4065) ,D( 466) ,D( 407) ,D( 408) ,D( 449) ,D( 410), 
+D(411),D(412),D(413) ,D(414), D( 415) ,D(416) ,D(417) ,D(418) ,D(419), 
+D( 420) ,D(421),D( 422) ,D( 423) ,D( 424) ,D( 425) ,D( 426) ,D(427) ,D(428), 
+D( 429) ,D(436),D(431) ,D(432), D(433),D( 434) ,D( 435) ,D(436) ,D( 437), 
+D(438) ,D( 439), D(44@) / 
+14976734.E-16, 5293311. E-18,1.,1.,0.5,93797465.E-@9, 84690176.E-1¢9, 
+42524183.E-11, 12746945.E-12, 233559062. E-14, 25642831.E-16, 
+15495967.E-18, 3962808.E-20,1.,1.,0.5,94252811.E-09, 86352191.E-19, 
+44683802.E-11,14135170.E-12, 28359079 .E-14, 36242862.E-16, 
+28591262.E-18, 12691526 .E-2@, 24249737. E-23,1.,1.,0.5, 94597848. E-@9, 
+87619296.E-10, 4635 7872. E-11, 15246910.E-12, 32599754.E-14, 
+46107927.E-16, 42819928. E-18, 25110371. E-20, 84319465.E-23, 
+12357105.E-25/ 


ORDER= INFO (12) 

M=INFO(9) 
IF(INFO(13).LT.2) GOTO 5@ 
M1=176% (ORDER- 1)+M* (M+1) /2-3 
M2=88+M1 

MM=M+1 

DO 1@ J=1,MM 

M1PJ=M1+J 

M2PJ=M2+J 

P(J)=D(M1PJ) 

S(J)=D (M2PJ) 


1@ CONTINUE 


IF(M.GT.2) GOTO 2@ 
P(4)=0.0 
S(4)=0.0 


20 DD=1. 375-.6*FLOAT(ORDER-1) 


36 


Ag 


50 


69 


E=P(2)+2.@*(-P (3)+P(4)+5 (4)) 

C(M) =(E/DD-( (DD~@. 5) /DD) **2)/(2.+E) 
LA (M)=1.@/DD-C (M) 

LA (M-1)=S (3) /LA(M) 
C(M-1)=P (3) /LA(M) 
B(1)=(P(2)-C (M)) /LA(M) 

B(2)=P(1) 

IF(M.GT.2) GOTO 3 

RETURN 


MM=M-— 2 

DO 4¢ J=1,™M 

MP 2MJ=M+2-J 

MP IMJ=M+1-J 

C(J)=P (MP2MJ)/S(MP1MJ) 
LA (J)=S(MP2MJ) /S (MP1MJ) 
CONTINUE 

RETURN 


M1=352-4M* (M+1)/2-3 
MM=M+1 

DC 66 J=1,™™ 
MIPJ=M1+J 
S(J)=D(M1PJ) 
B(1)=0.0 

B(2)=0.0 

C(M)=0.@ 

LA(M)=S (1) 

MM=M-1 

DO 7@ J=1,™M 

MP 2MJ=M+2-J 

MP 1MJ=Mt1-J 
LA(J)=S (MP 2MJ) /S (MP1MJ) 
C(J)=0.6 


6160 
6179 
618@ 
6190 
6200 
6210 
6226 
6230 
6240 
6250 
6260 
6270 
6280 
6290 
6300 
631¢ 
6320 
6330 
6340 
6350 
6360 
6370 
6380 
6390 
6400 
6416 
6420 
6430 
6446 
6450 
6460 
6470 
6480 
6490 
6500 
651¢ 
6520 
6530 
6540 
6550 
6560 
6570 
6580 
6590 
6600 
6610 
6620 
6630 
6640 
6650 
6660 
6670 
6680 
6690 
6700 
6710 
6720 
6730 
6740 
6750 
6760 
6770 
6780 
6796 
6800 
6810 
6820 
6830 
6840 
6850 
6860 
6870 
6880 
6890 
6900 
6910 
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COLLECTED ALGORITHMS (cont.) 


70 CONTINUE 
RETURN 
END 


SUBROUTINE POWERM(N, Y, Y1,YXE,DY,DY1, F, SIGMA, APR, IFLAG, INFO) 


CRERKEKKEKKKKEKERKRERREKREREREREERERERERRERERRRRRERERERERRRRERRRERERERERKE 


Cx 


IF ON ENTRY SIGMA(1)=@ POWERM COMPUTES AN ESTIMATION OF THE SPECTR- 
AL RADIUS OF THE JACOBIAN BY MEANS OF AN ADJUSTED POWER METHOD.THE 
ITERATION IS STOPPED IF TWO SUCCESSIVE ITERATES DIFFER RELATIVELY 
LESS THAN @.@@1.THE MINIMAL NUMBER OF ITERATIONS IS 5.1IF THE COMPU- 
TATION DID NOT SUCCEED WITHIN 5@ ITERATIONS AN ERRORMESSAGE IS GIV- 
EN.AS A SAFETY MARGIN,THE LAST ITERATE IS ENLARSED WITH 1@ PERCENT. 
THE RESULT IS STORED IN SIGMA(1). 


IF ON ENTRY SIGMA(1) NOT EQUALS @ POWERM PERFORMS THREE ITERATIONS 
WITH THE ADJUSTED POWER METHOD.IF THE THIRD ITERATE IS MORE THAN 1@ 
PERCENT SMALLER THAN SIGMA(2),THE ITERATION IS CONTINUED AS IF 
SIGMA(1)=@.IN THIS CASE THE THIRD ITERATE IS STORED IN SIGMA(2). 


THE POWER METHOD REQUIRES THREE WORK ARRAYS.WE USE YXE,DY AND DY1, 
WHERE DY AND DY1 ARE OVERWRITTEN.ON ENTRY OF THIS ROUTINE DY AND 
DY1 CONTAIN F(Y) AT Y=Y(X) AND Y=Y(X-H),RESPECTLVELY.THUS ON EXIT 
OF THIS ROUTINE TWO EXTRA EVALUATIONS OF F ARE NECESSARY FOR RESTO- 
RING THE DERIVATIVES. 


THIS CODE USES THE CDC SYSTEM SUBPROGRAMS RANSE'T AND RANF,GENE- 
RATING RANDOM VALUES FROM THE INTERVAL 10,1 . THE ARGUMENT OF RANF 


i i i ee a ee ee ee ee ae 


IS DUMMY AND IGNORED.RANSET INITIALIZES THE GENERATIVE VALUE OF RANF* 
CHRAKKEKAKKK AKER ER ER ER EKER ER EK RR EKER ER RRR ERE RR ER RRR ER ER ERR RRERERERRERRER 


DIMENSION Y(N),Y1(N),YXE(N),DY(N),DY1(N) ,SIGMA(2), INFO(15) 
REAL NORM, NORM@ 
IF(INFO(2).EQ.3) INFO(2)=1 
INFO (15)=@ 
TOLLIP=1.E+4*APR 
SIGM=9.@ 
SO=0.¢ 
CALL RANSET (@) 
DO 1@ I=1,N 
RA=2. *RANF (IDUM)-1. 
YXE(1)=DY(1) 
IF(Y(L).EQ.@.@) DY(I)=RA*TOLLIP 
IF(Y(1).NE.@.0) DY(I)=Y(1)*(1.@+TOLLIP*RA) 
DY1(L)=DY (1) 
SO=S@+DY (1) *DY (1) 
16 CONTINUE 
NORM@=TOLLIP*SQRT(S@) 
LF (NORM@. LT. TOLLIP ) NORMO=TOLLIP 
CALL F(N,DY1) 
INFO (7)=INFO(7)+1 
INFO (8)=INFO(8)+1 


DO 7@ K=1,51 
IF(K.LT.51) GOTO 2 
IFLAG=3 

RETURN 


20 SO=0 
DC 3¢ I=1,N 
S1=YXE(I)-DY1(1) 
SO=SG+S14*S1 

36 CONTINUE 
NORM=SQRT(S@) 
SIGM1=SIGM 
SIGM=NORM/NORM@ 


IF(K.EQ. 3. AND. SIGMA(1).EQ.6.0) SIGMA(2)=SIGM 
IF(K.LE.2.OR.SIGMA(1).EQ.@.6) GOTO 4¢ 
IF (SIGM.GE.@.9*SIGMA(2)) GOTO 8¢ 
SIGMA (2) =SIGM 
SIGMA(1)=0. 
4@ LF (ABS (SIGM1-SIGM) /SIGM.GT.@.@@1.OR.K.LE.4) GOTO 56 
SICMA(1)=1.1*SIGM 
GOTO 8@ 
5@ DO 6@ I=1,N 


6920 
6930 
6946 


6950 
6960 
6970 
6986 
6990 
7000 
70106 
7620 
7630 
7040 
7050 
7060 
7070 
7080 
7090 
7100 
7119 
712@ 
7130 
7140 
715@ 
7160 
7170 
718@ 
7190 
7200 
7216 
7220 
7230 
7240 
7250 
7260 
7270 
728@ 
7290 
7360 
731¢ 
7320 
7330 
7340 
735@ 
7360 
7370 
7380 
7390 
7400 
7410 
7420 
7430 
7440 
7450 
7460 
7470 
7480 
7490 
7500 
751 
7520 
7530 
7540 
7550 
7560 
757@ 
7580 
7590 
7600 
4848 
7630 
7640 
7659 
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60 


80 
96 


10@ 
11¢ 


YXE(1)=DY (1)+(YXE(1I)-DY1(1))/SIGM 
CALL F(N, YXE) 

INFO (7) =INFO(7)+1 

INFO (8)=INFO (8)+1 

CONTINUE 


DO 9@ I=1,N 

DY (I)=Y(I) 

CALL F(N,DY) 

INFO (7)=INFO(7)+1 
INFO (8)=INFO(8)+1 
IF(INFO(13).NE.9) GOTO 10 
RETURN 

DO 11@ I=1,N 
DY1(I)=Y1(1) 

CALL F(N,DY1) 
INFO (7)=INFO(7)+1 
INFO (8)=INFO(8)+1 
RETURN 

END 


SUBROUTINE MAXDEG(TOL, APR, IFLAG, INFO) 
CRAEKKRKRKAKKAK AKER ER RRER ERE RK RRR ERERER ERR RRR RRR ERRERERERERRERERERKER 


c* IN MAXDEG THE MAXIMAL DFGREES WITH RESPECT TO THE INTERNAL STABILI- * 


C* TY CONDITION ARE COMPUTED. IF ONE OF THESE MAXIMAL DEGREES FALLS 
C* OUTSIDE THE RANGE,AN ERRORMESSAGE IS GIVEN. 


* 
* 


CRHEKERERKKAKERKRRRERRKRERRERERERERRERRRRKRRRERKRERRERR RRR RERRRRERRERRRRERE 


1¢ 


20 


30 


4@ 


DIMENSION Q(11), INFO(15) 


DATA Q(1),Q(2) ,Q(3),Q(4) ,Q(5) 5Q(6) .Q(7) 5 Q(8) 5Q(9) Q(10) , Q(11) / 
+3.E1,1.E2, 7.E2, 4.E3, 3.E4,2.E5,9.E5,5.E6,3.E7,2.E8,1.£9/ 


E=TOL/APR 

DO 16 I=2,12 

J=13-1 

IF(Q(J).LE.E) GOTO 29 
CONTINUE 

IFLAG=2 

RETURN 


INFO (1) =14-1 

DO 3@ I=2,12 

J=13-1 

IF (10@.0*Q(J).LE.E) GOTO 4¢ 
CONTINUE 

LFLAG=2 

RETURN 


INFO(11)=14-I 


RETURN 
END 


SUBROUTINE MINDEG(H, SIGMA, INFO) 


CRAEKKKRKKRKKKERERRKRERERRERRER RR ERER RR RRRERE RRR RERE RRR RERER ARK RERRRRREREK 


C* MINDEG DETERMINES THE MINIMAL DEGREE M WHICH STILL GIVES RISE TO A 


C* STABLE INTEGRATION STEP. 
CHAKA KERR ARERR KEK RKERRRERR RE RRR ER EKER ER ER ER ER RR ERR RR ER RE RR RER ERR 


10 
20 


DIMENSION INFO(15) 
LOGICAL START 
L=INFO (12)+9 
MMAX=INFO(L) 
START=INFO (13) .LT.2 


IF(.NOT.START) BETAC=5.15+2. 86*FLOAT (1-INFO(12)) 


DO 1¢@ M=2,MMAX 

RM=M 

IF(START) BETAC=@.@3*RM+Q. 44 

IF (H.LE. BETAC*RM*RM/ SIGMA) GOTO 206 
CONTINUE 

M=MMAX 

INFO (9)=M 

RETURN 

END 


SUBROUTINE STEP(N,Y,Y1,Y2, YXE, DY, DY1,H,F,C,LA,B, INFO) 


* 
* 


CREKKKEEKERKRKRKRRKRERKKRRRRERERERERRRRRRERERERRRERERERRERRRRRERRERRRRRRERE 


7660 
7670 
7680 
7690 
7700 
7710 
7720 
7730 
7740 
775@ 
7760 
7770 
7780 
7790 
7800 
7810 
782@ 
783 
7840 
7850 


7860 
7870 
7886 
7896 
7900 
791¢ 
7920 
7930 
7940 
7950 
7960 
7979 
7980 
7990 
8000 
8010 
80206 
8030 
8040 
8050 
8060 
8070 
8680 
8090 
810¢ 
8110 
8120 
8130 


8140 
8150 
8160 
8170 
8180 
8190 
8260 
8210 
8220 
8230 
8246 
8256 
8269 
8270 
8280 
8290 
8300 
8310 
8320 
8330 


8346 
8350 
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C* STEP CONTAINS THE ACTUAL INTEGRATOR.FOR CONVENIENCE,THE ONE-STEP 


* 


C* SCHEME IS ALSO FORMULATED AS A THREE-STEP SCHEME BY INTRODUCING ZE- * 


C* RO-PARAMETERS.ON EXIT OF THIS ROUTINE THE NEW CALCULATED SOLUTION 


C* VECTOR IS CONTAINED IN YXE. 
CHARA RK RK KK EKER RK EKA ER KR EKER ERE RRR ER AREER ERK EK RRR RRR RRR RERRRRERER 


REAL LA 


DIMENSION Y(N),Y1(N) ,Y2(N),YXE(N),DY(N) ,DY1(N), 


+LA(12),C(12) ,B(2), INFO(15) 
M=INFO (9) 
D=1.375-.6*FLOAT (INFO(12)-1) 
IFC(INFO(13).LT.2) D=1.@ 
DO 1@ I=1,N 


1@ YXE(1)=DY(I) 


IF(M.EQ.2) GOTO 40 
MM=M-2 


DO 36 J=1,MM 

HC=H4C (J) 

HLA=H4LA (J) 

DC 2@ I=1,N 

YXE(1)=Y (1 )+HC*RY1 (1) +HLA*YXE(1) 


20 CONTINUE 


CALL F(N,YXE) 
INFO (7)=INFO (7)+1 


3@ CONTINUE 


4@ BM1=B(1) 


50 


60 


BM11=1.@-BM1 
HC=HC (M-1) 
HLA=H*LA (M-1) 
DO 5@ I=1,N 


D1l=1.-D 
BM1=B(2)*D 
BM11=(1.-B(2))*D 
HC=H&C (M) *D 
HLA=H*LA (M)*D 
CALL F(N, YXE) 
INFO (7)=INFO(7)+1 


DO 6@ I=1,N 
YXE(1)=BM11*Y(1L)+BM1*Y1(1)+D1*Y2 (1)+HC*DY1 (1)+HLA*YXE(I) 
RETURN 

END 


SUBROUTINE ESTIMA(N,Y,Y1,Y2,YXE,TOL, EPS, ERROR, INFO) 


YXE (1) =BM11*Y(1)+BM1*Y1(1)+HC*DY1(1) +HLA*YXE(I) 


k 
* 


CRRA: RAK AK AKKK AK KKK RK RRR KKK RR RR ER ERE RRR KK KER EAR RRE RRRRER EERE RK 
C* ESTIMA CALCULATES THE LOCAL ERROR BOUND EPS=(1+NORM(Y))*TOL FOR THE * 


C* MIXED ERROR TEST AND ESTIMATES THE LOCAL ERROR ERROR. 


* 


CREKEARRRKKERK EKER RE RRERER ERR EKEKEK RR RK ERR RK RKERRRUKREREREKRERERERERRRREEE 


10 


20 


30 
40 


DIMENSION Y(N),Y1L(N) ,Y2(N) , YXE(N), INFO(15) ,CONST(2) 


INTEGER ORDER 

CONST (1)=4.7@ 

CONST (2)=@.79 
ORDER=INFO (12) 
EPS=0.@ 

ERROR=@. @ 
IF(ORDER.EQ.2) GOTO 20 
DO 16 I=1,N 

YI=Y¥ (I) 
EPS=EPS+YI*YI 
E=Y1(1)-YI-YI+YXE(1) 
ERROR=ERROR+E*E 

CONT LNUE 


GOTO 4@ 

DO 3@ I=1,N 

EPS=EPS+Y (1) *Y(L) 
E=-Y2(1)+3.0*(Y1(1)-Y¥ (1) )+YXE(1) 
ERROR=ERROR+E*E 

CONTINUE 


EPS=TOL+TOL* SQRT (EPS /FLOAT (N) ) 
ERROR=CONST (ORDER) *SQRT (ERROR/ FLOAT (N) ) 
RETURN 

END 
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SUBROUTINE NEWH(EPSERR, HOLD, H,ALFA,HMAX, INFO) 916¢ 
CREKKERAKERKRKRKKKEEREKERERERERR ERR RRR ERERE EER ERE RE RERERERRRERERRERRRERE 911¢ 
C* NEWH DELIVERS A NEW STEPLENGTH AND THE FACTOR ALFA BY WHICH THE * 9126 
C* STEPLENGTH IS CHANGED. EPSERR DENOTES EPS/ERROR. * 913¢ 
CHAKRKEKKKRERKRKREERRRRRRERRERRRRERERERRRER RRR EREREREERRERRERERRKERERRRERERERRRKRERE 9146 

DIMENSION HMAX(2), INFO(15) 915 

INTEGER ORDER 916 

ALFA=1.@ 917¢ 

IF (INFO(14).GE.3.OR.EPSERR.LE.1.@) GOTO 1¢ 918¢ 

RETURN 919¢ 
Cc 920 

1@ ORDER=INFO (12) 9210 

ALFA=EPSERR** (1. /FLOAT (ORDER+1)) / (2. @-FLOAT (ORDER-1) *@.4) 9226 

IF (ALFA.GT.@.9.AND.ALFA.LT.1.1) ALFA=1.@ 923¢ 

IF(ALFA.NE.1.0) GOTO 2¢ 9246 
C 925¢ 

RETURN 9260 

20 IF(ALFA.GT.3.@) ALFA=3.@ 9270 

IF(ALFA.LT.@.1) ALFA=@.1 9280 

H=HOLD*ALFA 9296 

IF (H.GT.HMAX (ORDER) ) H=HMAX(ORDER) 9300 

ALFA=H/HOLD 931¢ 

RETURN 9320 

END 933¢ 

SUBROUTINE INTER1(N,Y,Y1,Y2,DY1,F,ALFA, INFO) 9340 


CRRA KK ARAREKKAKEKEKKERER EK RKERERRERERKRRRRER RRR ERERERRERRERRERERERERERRRERERERE 935¢ 


c* INTER1 COMPUTES VALUES FOR Y(X-ALFA*H) AND Y(X-2*ALFA*H) FROM Y(X), * 9360 
C* Y(X-H) AND Y¥(X-2H) BY QUADRATIC INTERPOLATION,AND COMPUTES THE DER- * 9379 


C* IVATIVE AT X-H BY CALLING F. k 9380 
CRERKERKRKKKERERKEKRERKR ERE RRERRRER ER EERE RR RRERRRERRERRRERRRRRRERRRRKRERE 9390 
DIMENSION Y(N) ,Y1(N) ,Y¥2(N) ,DY1(N), INFO(15) 9400 

REAL NU 941¢ 
NU=2.-ALFA 9426 
C12=(NU-1.)* (NU-2. )/2. 9430 
C11=NU*(2.-NU) 9449 
C1O=NU*(NU-1.)/2. 9450 
NU=2.-2. *ALFA 9460 
C22=(NU-1. )*(NU=-2. )/2. 9470 
C21=NU* (2. -NU) 9486 
C2Q=NU* (NU-1.)/2. 9499 

Cc 9500 
DO 1@ I=1,N 951¢ 
CY@=Y (1) 952¢ 
CY1=Y1(TI) 9536 

CY 2=Y2(1) 9540 
Y1(1)=C12*CY 2+C11*CY14+C1O*CYO 955¢ 
DY1(1)=Y1(1) 9560 
Y2(1)=C22*CY24+C21*CY1+C2Q*CYO 9570 

10 CONTINUE 9580 
CALL F(N,DY1) 959 
INFO (7)=INFO(7)+1 9600 

INFO (14) =@ 9610 
RETURN 9620 

END 9630 
SUBROUTINE INTER2(N,Y,Y1,Y2, YXE, A) 9646 


CHEK KRKAKKKEKREK EKER EKER KK RERKEREAK EK RK RR AK EKRKEKERERERERERKERERERERERERERKRE = 9650 


c* INTER2 COMPUTES THE SOLUTION AT THE OUTPUT POINT XE=X-A*H BY QUAD- * 9660 
C* RATIC INTERPOLATION BETWEEN Y(X),Y(X-H) AND Y(X-2H).THE RESULT IS * 9670 


C* STORED IN YXE. * 9686 
CHAKRKAKKKARKAKKKEKRKRIEKERRKERKEEKRRRR AREER REE ER ERRERERERERRERERERERERKEERRKK 969¢ 
DIMENSION Y(N),Y1(N),Y2(N) , YXE(N) 9700 

REAL NU 9710 
NU=2.-A 9720 
C12=(NU-i.)* (NU-2.)/2. 9730 
CL1=NU* (2. -NU) 9740 
C1LO=NU* (NU-1.)/2. 9750 

DO 1@ I=1,N : 9760 

1@ YXE(L) =C12*Y2(1)+C11*Y1(1)+C1O*Y (1) 97706 
RETURN 9780 


END 9790 


COLLECTED ALGORITHMS (cont.) 


CREEKRKEKKRK RE KEKRKKREKRKEEKKERREKRERE RE ER EKRREERER RRR RRREKKRERERRRERER ERE 


SUBROUTINE SHIFT(N,Y,Y1, Y2,YXE,DY,DY1,X,H,F, INFO) 


C* SHIFT SHIFTS THE X AND Y VARIABLES AND COMPUTES F(Y¥(X+H) ) 
CRERKK AK AK KK AK KKRKAAK KK RRR ER RRARRRERERAREERERK ERIARRERE RRR RERERRAERE RE 


10 


DIMENSION Y(N),Y1(N),Y2(N) , YXE(N) ,DY(N) , DY1(N), INFO(15) 
pC 1@ I=1,N 
Y2(I)=Y1(1) 
Y1(1)#Y(L) 
Y(I)=YXE (I) 
DY1(I)=DY(I) 

DY (I)=¥(1) 
CONTINUE 

CALL F(N,DY) 

INFO (7)=INFO(7)+1 
X=X+H 


* 


9800 
9810. 
9820 
983¢ 
984@ 
985@ 
9860 
9870 
9880 
9890 
9900 
9919 
9924 
9930 
9940 
9950 
9960 
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ALGORITHM 554 


BRENTM, A Fortran Subroutine for the 
Numerical Solution of Systems of Nonlinear 
Equations [C5] 


JORGE J. MORE 

Argonne National Laboratory 

and 

MICHEL Y. COSNARD 

Université Scientifique et Médicale de Grenoble 


Key Words and Phrases: nonlinear equations, numerical solution, Brent’s method 
CR Categories: 4.6, 5.15 
Language: Fortran 


1. DESCRIPTION 


BRENTM is a subroutine designed to solve a system of n nonlinear equations in 
n variables by using a modification of Brent’s method [1]. This modification, and 
numerical results for our implementation, are discussed in [2]. 

Our subroutine does not use any techniques which attempt to obtain global 
convergence, and therefore convergence is only guaranteed if the initial estimate 
for the solution is close enough. On the other hand, our code does seem to have 
a large region of convergence; convergence only occurs at a zero of the function, 
and if the iteration is not making satisfactory progress, then BRENTM will 
attempt to diagnose this situation and stop the iteration with an appropriate 
message. 

The user is only required to provide a subroutine which calculates components 
of the function. Note that because of the nature of Brent’s method, it is advan- 
tageous to arrange the components of the function in increasing order of nonlin- 
earity; in particular, any linear components should appear first. 

The accuracy of BRENTM is controlled by the parameters FTOL and XTOL. 
Convergence occurs if all residuals are at most FTOL in magnitude. Thus FTOL 
should be chosen with care since an appropriate value depends on the scaling of 
the functions. Convergence also occurs if BRENTM estimates that 


where x* is a solution to the system of nonlinear equations and x is the current 
estimate of x*. Note that if x* has components of widely different magnitude, 
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then there is a danger that the smaller components of x will have large relative 
errors, but this usually does not happen because of the fast convergence of the 
iteration. 


2. BRENT1 


The complete generality provided by BRENTM is usually not required, and in 
these cases, the calling sequence can be shortened and simplified. We have 
incorporated the following simplifications into the easy-to-use driver BRENT. 
Note that BRENT1 has 8 parameters in the calling sequence, while BRENTM 
has 15. 


(1) Only allow one tolerance TOL by setting FTOL and XTOL equal to TOL. 
Unless there is information about the scaling of the function, this is a natural 


choice. 
(2) Let MOPT maximize log(k + 1)/(n + 2k + 1) for k = 1, 2,..., n. This is 


the value recommended in [1] and [2]. 

(3) Set MAXFEV to 50(n + 3). This limit permits 100 iterations of the 
algorithm, and in our experience BRENTM has either succeeded or reported 
unsatisfactory progress before this limit is reached. 

(4) Eliminate NFEV from the calling sequence. Many users are not interested 
in the number of function evaluations required by BRENTM, and in any case 
NFE’V can be computed by the user through FCN. 

(5) Condense all arrays not required by FCN into one work array WA of length 
LWA. BRENTM would need LWA to be at least n(n + 3). 


REFERENCES 
1. BRENT, R.P. Some efficient algorithms for solving systems of nonlinear equations. SIAM J. 
Numer. Anal. 10 (1973), 327-344. 
2. Moré, J.J., AND COSNARD, M.Y. Numerical solution of nonlinear equations. ACM T, ans. Math. 
Softw. 5, 1 (March 1979), 64-85. 


ALGORITHM 
c Sok dk ek RAK 00000016 
G 09900020 
C THIS IS A SAMPLE PROGRAM FOR THE EASY-TO-USE VERSION BRENT1 00900030 
Cc OF SUBROUTINE BRENTM. THIS PROGRAM SOLVES THE DISCRETE 9OO0G040 
Cc BOUNDARY VALUE PROBLEM DEFINED BY THE SYSTEM OF NONLINEAR 06000050 
Cc EQUATIONS 00000060 
Cc 06000076 
C 2*X(I) - X(I-1) - X(I4+1) $000008¢ 
Cc 90000090 
C + Q.5*(H**2)*(X(I) + I*H + 1)**3 = @ , T= 1,...,N 000006100 
C 00000116 
C WHERE H = 1/(N+1), AND X(@) = X(N+1) = @. 00000126 
Cc $0600130 
C KRRKEKKERKEAK 006000140 
INTEGER I, INT, INFO, LWA,N,NFCALL, NFEV,NWRITE 00000150 
DOUBLE PRECISION FNORM1, FNORM2,H, TEMP, TOL 00000160 
DOUBLE PRECISION X(106),FVEC(16),WA(13@) 906000170 
DOUBLE PRECISION DFLOAT 90000180 
EXTERNAL BVP 06000190 
COMMON /REFNUM/ NFCALL 99900200 
Cc 09000210 
C LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6. 000060226 
C 90900230 
DATA NWRITE /6/ 90000240 
Cc 0900060250 
DFLOAT(INT) = INT 00006260 
LWA = 13 00006270 
TOL = 1.D-10@ 990006280 
N= 10. 600060296 
Cc $00060300 
Cc STARTING VALUES. 90000310 
c 960060326 


H = 1.D@/DFLOAT(N+1) 


99000330 
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OQ 


C 


0 OO 


io) 


AQAANAQAAAQTAIANA 


19 


20 


30 


MP WHR 


pO 16 IT=1, N 
TEMP = DFLOAT (1)*H 
X(1) = TEMP*(TEMP - 1.D@) 
CONTINUE 


INITIAL MAX-NORM OF THE RESIDUALS. 


FNORM1 = @.D@ 

DO 26 I =1, N 
.CALL BVP(N, X, FVEC, I) 
FNORM1 = DMAX1(FNORM1, DABS (FVEC(I1))) 
CONTINUE 


NFCALL = @ 

CALL BRENT1(BVP,N, X, FVEC, TOL, INFO,WA, LWA) 
NFEV = NFCALL/N 

FINAL MAX-NORM OF THE RESIDUALS. 


FNORM2 = @.D@ 


pO 36 T=1, N 


CALL BVP(N, X, FVEC,I) 
FNORM2 = DMAX1(FNORM2, DABS (FVEC(I))) 
CONTINUE 


WRITE (NWRITE, 1000) N, FNORM1, FNORM2, NFEV, INFO, (X(I),I=1,N) 
STOP 


10@@ FORMAT (5X,1@H DIMENSION,15,5x // 


5X, 34H INITIAL MAX-NORM OF THE RESIDUALS,D15.7 // 
5X,34H FINAL MAX-NORM OF THE RESIDUALS ,D15.7 // 
5X, 33H NUMBER OF FUNCTION EVALUATIONS ,1106 // 

5X, 15H EXIT PARAMETER ,18X,11¢ // 

5X,27H FINAL APPROXIMATE SOLUTION // (5X,5D15.7)) 


LAST CARD OF SAMPLE PROGRAM. 


END 

SUBROUTINE BVP(N,X,FVEC, IFLAG) 
INTEGER N, [FLAG 

DOUBLE PRECISION X(N), FVEC(N) - 
REREKKRKEKE 


SUBROUTINE BVP DEFINES THE BOUNDARY VALUE PROBLEM. 


KEKKKRKKKEEE 

INTEGER INT, NFCALL 

DOUBLE PRECISION H, TEMP, TEMP 1, TEMP2 

DOUBLE PRECISION DFLOAT 

COMMON /REFNUM/ NFCALL 

DFLOAT(INT) = INT 

H = 1.D@/DFLOAT(N+1) 

TEMP = @.5D@*((X(IFLAG) + DFLOAT(IFLAG)*H + 1.D@)**3) 
TEMP1 = @.D@ 

IF (IFLAG .NE. 1) TEMP1 = X(IFLAG-1) 

TEMP2 = @.D@ 

IF (IFLAG .NE. N) TEMP2 = X(IFLAG+1) 

FVEC (IFLAG) = 2.D@*X(IFLAG) - TEMP1 - TEMP2 + TEMP*H**2 
NFCALL = NFCALL + 1 

RETURN 


LAST CARD OF SUBROUTINE BVP. 


END 

SUBROUTINE BRENT1(FCN,N, X, FVEC, TOL, INFO, WA, LWA) 
INTEGER N, INFO,LWA 

DCUBLE PRECISION TOL 

DOUBLE PRECISION X(N), FVEC(N) , WA (LWA) 

EXTERNAL FCN 

KRREREKKAK 


SUBROUTINE BRENT1 


THE PURPOSE OF THIS SUBROUTINE IS TO FIND A ZERO OF 

A SYSTEM OF N NONLINEAR EQUATIONS IN N VARIABLES BY A 
METHOD DUE TO R. BRENT. THIS IS DONE BY USING THE 
MORE GENERAL NONLINEAR EQUATION SOLVER BRENTM. 
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THE SUBROUTINE STATEMENT IS 
SUBROUTINE BRENT1(FCN,N,X, FVEC,TOL, INFO, WA, WA) 
WHERE 


FCN IS THE NAME OF THE USER-SUPPLIED SUBROUTINE WHICH 


CALCULATES COMPONENTS OF THE FUNCTION. FCN SHOULD BE 
DECLARED IN AN EXTERNAL STATEMENT IN THE JSER CALLING 
PROGRAM, AND SHOULD BE WRITTEN AS FOLLOWS. 


SUBROUTINE FCN (N,X, FVEC, IFLAG) 

INTEGER N, IFLAG 

DOUBLE PRECISION X(N), FVEC(N) 

CALCULATE THE IFLAG-TH COMPONENT OF THE FUNCTION 
AND RETURN THIS VALUE IN FVEC(IFLAG). 

RETURN 

END 


THE VALUE OF IFLAG SHOULD NOT BE CHANGED BY FCN UNLESS 
THE USER WANTS TO TERMINATE EXECUTION OF BRENT1. 
IN THIS CASE SET IFLAG TO A NEGATIVE INTEGER. 


N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER 


OF EQUATIONS AND VARIABLES. 


X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN 
AN INITIAL ESTIMATE OF THE SOLUTION VECTOR. ON OUTPUT X 


CONTAINS THE FINAL ESTIMATE OF THE SOLUTION VECTOR. 


FVEC IS AN ARRAY OF LENGTH N. ON OUTPUT IT CONTAINS 


THE FINAL RESIDUALS. 


TOL IS A NONNEGATIVE INPUT VARIABLE. THE ALGORITHM CONVERGES 
IF EITHER ALL THE RESIDUALS ARE AT MOST TOL IN MAGNITUDE, 


OR IF THE ALGORITHM ESTIMATES THAT THE RELATIVE ERROR 
BETWEEN X AND THE SOLUTION IS AT MOST TOL. 


INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS. IF 


THE USER HAS TERMINATED EXECUTION, INFO WILL BE SET TO 
THE (NEGATIVE) VALUE OF IFLAG. SEE DESCRIPTION OF FCN. 
OTHERWISE 


INFO = @ IMPROPER INPUT PARAMETERS. 

INFO = 1 ALL RESIDUALS ARE AT MOST TOL IN MAGNITUDE. 

INFO = 2. ALGORITHM ESTIMATES THAT THE RELATIVE ERROR 
BETWEEN X AND THE SOLUTION IS AT MOST TOL. 

INFO = 3. CONDITIONS FOR INFO = 1 AND INFO = 2 BOTH HOLD. 

INFO = 4 NUMBER OF FUNCTION EVALUATIONS HAS REACHED OR 
EXCEEDED 50*(N+3). 

INFO = 5 APPROXIMATE JACOBIAN MATRIX IS SINGULAR. 

INFO = 6 ITERATION IS NOT MAKING GOOD FROGRESS. 

INFO = 7 ITERATION IS DIVERGING. 

INFO = 8 ITERATION IS CONVERGING, BUT TOL IS TOO 


SMALL, OR THE CONVERGENCE IS VERY SLOW 
DUE TO A JACOBIAN SINGULAR NEAR THE OUTPUT 
X OR DUE TO BADLY SCALED VARIABLES. 


WA IS A WORK ARRAY OF LENGTH LWA. 


LWA IS A POSITIVE INTEGER INPUT VARIABLE NOT LESS THAN 


N* (N+3). 


SUBPROGRAMS REQUIRED 
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3@ CONTINUE 


USER-SUPPLIED FCN, BRENTM 


FORTRAN-SUPPLIED ... DLOG 


RKEKEKKEKEKRK 

INTEGER I, IVAR, MAXFEV, MOPT , NFEV 

DOUBLE PRECISION EMAX, FTOL, TEMP, XTOL, ZERO 
DOUBLE PRECISION DFLOAT 

DATA ZERO /@.DQ@/ 

DFLOAT(IVAR) = IVAR 

INFO = @ 


CHECK THE INPUT PARAMETERS FOR ERRORS. 


IF (N .LE. @ .OR. TOL .LT. ZERO .OR. LWA .LT. N*(N+3)) GO TO 36 


DETERMINE AN OPTIMAL VALUE FOR MOPT. 


EMAX = ZERO 
po i@ I=1, N 
TEMP = DLOG(DFLOAT(I+1)) /DFLOAT (N+2*I+1) 
IF (TEMP .LT. EMAX) GO TO 206 
MOPT = I 
EMAX = TEMP 
CONTINUE 
CONTINUE 


CALL BRENTM. 


MAXFEV = 50*(N + 3) 

FTOL = TOL 

XTOL = TOL 

CALL BRENTM(FCN,N, X, FVEC, FTOL, XTOL, MAXFEV,MOPT, 

INFO, NFEV, WA(3*N+1) ,N,WA(1) ,WA(N+1) , WA(2*N+1)) 


RETURN 
LAST CARD OF SUBROUTINE BRENT1. 


END 

SUBROUTINE BRENTM(FCN,N, X, FVEC, FTOL, XTOL,MAXFEV,MOPT, 
t INFO, NFEV,Q, LDQ, SIGMA, WA1, WA2) 
INTEGER N,MAXFEV,MOPT, INFO,NFEV, LDQ 

DOUBLE PRECISION FTOL, XTOL 


DOUBLE PRECISION X(N), FVEC(N) ,Q(LDQ,N) ,SIGMA(N) ,WA1(N) ,WA2(N) 
RREKKKKERE 


SUBROUTINE BRENTM 


THE PURPOSE OF THIS SUBROUTINE IS TO FIND A ZERO TO 
A SYSTEM OF N NONLINEAR EQUATIONS IN N VARIABLES BY A 
METHOD DUE TO R. BRENT. 


THE SUBROUTINE STATEMENT IS 


SUBROUTINE BRENTM(FCN,N, X, FVEC, FTOL, XTOL,MAXFEV,MOPT, 
INFO, NFEV, Q, LDQ, SIGMA, WAL, WA2) 


WHERE 


FCN IS THE NAME OF THE USER-SUPPLIED SUBROUTINE WHICH 
CALCULATES COMPONENTS OF THE FUNCTION. FCN SHOULD BE 
DECLARED IN AN EXTERNAL STATEMENT IN THE USER CALLING 
PROGRAM, AND SHOULD BE WRITTEN AS FOLLOWS. 


SUBROUTINE FCN(N,X, FVEC, IFLAG) 

INTEGER N, IFLAG 

DOUBLE PRECISION X(N), FVEC(N) 

CALCULATE THE IFLAG-TH COMPONENT OF THE FUNCTION 
AND RETURN THIS VALUE IN FVEC(IFLAG). 

RETURN 

END 


THE VALUE OF IFLAG SHOULD NOT BE CHANGED BY FCN UNLESS 
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THE USER WANTS TO TERMINATE EXECUTION OF 3RENTM. 
IN THIS CASE SET IFLAG TO A NEGATIVE INTEGER. 


N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER OF 
EQUATIONS AND VARIABLES. 


X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN 
AN ESTIMATE TO THE SOLUTION OF THE SYSTEM OF EQUATIONS. 
ON OUTPUT X CONTAINS THE FINAL ESTIMATE TO THE SOLUTION 
OF THE SYSTEM OF EQUATIONS. 


FVEC IS AN ARRAY OF LENGTH N. ON OUTPUT IT CONTAINS 
THE FINAL RESIDUALS. 


FIOL IS A NONNEGATIVE INPUT VARIABLE. CONVERGENCE 
OCCURS IF ALL RESIDUALS ARE AT MOST FTOL IN MAGNITUDE. 


XTOL IS A NONNEGATIVE INPUT VARIABLE. CONVERGENCE 
OCCURS IF THE RELATIVE ERROR BETWEEN TWO SUCCESSIVE 
ITERATES IS AT MOST XTOL. 


MAXFEV IS A POSITIVE INTEGER INPUT VARIABLE. TERMINATION 
OCCURS IF THE NUMBER OF FUNCTION EVALUATIONS IS AT 
LEAST MAXFEV BY THE END OF AN ITERATION. IN BRENTM, 

A FUNCTION EVALUATION CORRESPONDS TO N CALLS TO FCN. 


MOPT IS A POSITIVE INTEGER INPUT VARIABLE. MOPT SPECIFIES 
THE NUMBER OF TIMES THAT THE APPROXIMATE JACOBIAN IS 
USED DURING EACH ITERATION WHICH EMPLOYS ITERATIVE 
REFINEMENT. IF MOPT IS 1, NO ITERATIVE REFINEMENT WILL 
BE DONE. MAXIMUM EFFICIENCY IS USUALLY OBTAINED IF 
MOPT MAXIMIZES LOG(K+1)/(N+2*K+1) FOR K = 1,...,N. 


INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS. IF 
THE USER HAS TERMINATED EXECUTION, INFO WILL BE SET TO 
THE (NEGATIVE) VALUE OF IFLAG. SEE DESCRIPTION OF FCN. 
OTHERWISE 


INFO = @ IMPROPER INPUT PARAMETERS. 

INFO = 1 ALL RESIDUALS ARE AT MOST FTOL IN MAGNITUDE. 

INFO = 2 RELATIVE ERROR BETWEEN TWO SUCCESSIVE ITERATES 
IS AT MOST XTOL. 

INFO = 3 CONDITIONS FOR INFO = 1 AND INFO = 2 BOTH HOLD. 

INFO = 4 NUMBER OF FUNCTION EVALUATIONS HAS REACHED OR 
EXCEEDED MAXFEV. 

INFO = 5 APPROXIMATE JACOBIAN MATRIX IS SINGULAR. 

INFO = 6 ITERATION IS NOT MAKING GOOD PROGRESS. 

INFO = 7 ITERATION IS DIVERGING. 

INFO = 8 ITERATION IS CONVERGING, BUT XTOL IS TOO 


SMALL, OR THE CONVERGENCE IS VERY SLOW 
DUE TO A JACOBIAN SINGULAR NEAR THE OUTPUT 
X OR DUE TO BADLY SCALED VARIABLES. 


NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF 
FUNCTION EVALUATIONS USED IN PRODUCING X. IN BRENTM, 
A FUNCTION EVALUATION CORRESPONDS TO N CALLS TO FCN. 


Q IS AN N BY N ARRAY. IF JAC DENOTES THE APPROXIMATE 
JACOBIAN, THEN ON OUTPUT Q IS (A MULTIPLE OF) AN 
ORTHOGONAL MATRIX SUCH THAT JAC*Q IS A LOWER TRIANGULAR 
MATRIX. ONLY THE DIAGONAL ELEMENTS OF JAC*Q NEED 
TO BE STORED, AND THESE CAN BE FOUND IN SIGMA. 


LDQ IS A POSITIVE INTEGER INPUT VARIABLE NOT LESS THAN N 
WHICH SPECIFIES THE LEADING DIMENSION OF THE ARRAY Q. 


SIGMA IS A LINEAR ARRAY OF LENGTH N. ON OUTPUT SIGMA 
CONTAINS THE DIAGONAL ELEMENTS OF THE MATRIX JAC*Q. 
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SEE DESCRIPTION OF Q. 
WAl AND WA2 ARE LINEAR WORK ARRAYS OF LENGTH N. 
SUBPROGRAMS REQUIRED 


USER-SUPPLIED 


FORTRAN-SUPPLIED ... DABS, DMAX1,DSQRT,DSIGN 


KAKKKKKKKK 

INTEGER I, IFLAG,J,K,M, NFCALL, NIER6, NIER7,NIER8, NSING 
LOGICAL CONV 

DOUBLE PRECISION DELTA, DIFIT,DIFIT1, EPS ,EPSMCH, ETA, FKY , FKZ, 
1 FNORM, FNORM1, H, P@5, SCALE, SKNORM, TEMP , XNORM, ZERO 
DATA ZERO,P@5,SCALE /@.D@,5.D-2,1.D1/ 


WARNING. 


THIS IS AN IBM CODE. TO RUN THIS CODE ON OTHER MACHINES IT 
IS NECESSARY TO CHANGE THE VALUE OF THE MACHINE PRECISION 
EPSMCH. THE MACHINE PRECISION IS THE SMALLEST FLOATING 
POINT NUMBER EPSMCH SUCH THAT 


1 + EPSMCH .GT. 1 
IN WORKING PRECISION. IF IN DOUBT ABOUT THE VALUE OF 
EPSMCH, THEN THE FOLLOWING PROGRAM SEGMENT DETERMINES 
EPSMCH ON MOST MACHINES. 


EPSMCH = 
CONTINUE 
IF (1.D@+EPSMCH .EQ. 1.D@) GO TO 2 
EPSMCH = @.5DQ@*EPSMCH 

GO TO 1 
CONTINUE 
EPSMCH = 


@.5D@ 


2. DO*EPSMCH 
THE IBM DOUBLE PRECISION EPSMCH. 


EPSMCH = 16. D@** (-13) 


CHECK THE INPUT PARAMETERS FOR ERRORS. 


IF (N .LE. @ .OR. FIOL .LT. ZERO .OR. XTOL .LT. ZERO .OR. 
1 MAXFEV .LE. @ .OR. MOPT .LE. @ .OR. LDQ .LT. N) GO TO 220 


INITIALIZE SOME OF THE VARIABLES. 


NIER6 = -1l 

NIER7 = -l 

NIER8 = @ 

FNORM = ZERO 

DIFIT = ZERO 

XNORM = ZERO 

po 19 L=1, N 
XNORM = DMAX1 (XNORM, DABS (X(I) )) 
CONTINUE 

EPS = DSQRT(EPSMCH) 

DELTA = SCALE*XNORM 


IF (XNORM .EQ. ZERO) DELTA = SCALE 
ENTER THE PRINCIPAL ITERATION. 
CONTINUE 


TO PRINT THE ITERATES, PLACE WRITE STATEMENTS 
FOR THE VECTOR X HERE. 


NSING = N 


FNCRM1 = FNORM 
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DIFIT1L = DIFIT 
FNORM = ZERO 


COMPUTE THE STEP H FOR THE DIVIDED DIFFERENCE WHICH 


APPROXIMATES THE K-TH ROW OF THE JACOBIAN MATRIX. 


H = EPS*XNORM 
IF (H .EQ. ZERO) H = EPS 
pO 49 J = 1, N 
pO 3 L=1, N 
Q(I,J) = ZERO 
CONTINUE 
OG.) =H 
WAL(J) = X(J) 
CONTINUE 


ENTER A SUBITERATION. 


CALL FCN(N,WA1, FVEC, IFLAG) 

FKY = FVEC(K) 

NFCALL = NFCALL + 1 

NFEV = NFCALL/N 

IF (IFLAG .LT. @) GO TO 230 
FNORM = DMAX1 (FNORM, DABS (FEY) ) 


COMPUTE THE K-TH ROW OF THE JACOBIAN MATRIX. 


DO 66 J = K, N 
po 5@ I1=1, N 
WA2(1) = WA1(I) + Q(1,J) 
CONTINUE 
CALL FCN(N,WA2, FVEC, IFLAG) 
FKZ = FVEC(K) 
NFCALL = NFCALL + 1 
NFEV = NFCALL/N 
IF (IFLAG .LT. @) GO TO 230 
SIGMA(J) = FKZ - FKY 
CONTINUE 
FVEC(K) = FKY 


COMPUTE THE HOUSEHOLDER TRANSFORMATION TO REDUCE THE K-TH ROW 
OF THE JACOBIAN MATRIX TO A MULTIPLE OF THE K-TH UNIT VECTOR. 


ETA = ZERO 
DO 70 I = K, N 
ETA = DMAXL(ETA, DABS (SIGMA(I))) 
CONTINUE 
IF (ETA .EQ. ZERO) GO TO 15@ 
NSING = NSING - 1 
SKNORM = ZERO 
DO 86 IT =K, N 
SIGMA(I) = SIGMA(I)/ETA 
SKNORM = SKNORM + SIGMA(I)**2 
CONTINUE 
SKNORM = DSQRT(SKNORM) 
IF (SIGMA(K) .LT. ZERO) SKNORM = -SKNORM 
SIGMA(K) = SIGMA(K) + SKNORM 


APPLY THE TRANSFORMATION AND COMPUTE THE MATRIX Q. 


po 99 T=1, N 
WA2(I) = ZERO 
CONTINUE 
pO 119 J = K, N 
TEMP = SIGMA(J) 
DO 100 1 = 1, N 
WA2(I) = WA2(I) + TEMP*Q(I,J) 
CONTINUE 
CONTINUE 
DO 136 J = K, N 
TEMP = SIGMA(J)/(SKNORM*SIGMA(R) ) 
pO 12@ I=1, N 
Q(I,J) = Q¢I,J) - TEMP*WA2(I) 
CONTINUE 
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CONT INUE 
COMPUTE THE SUBITERATE. 


SIGMA(K) = SKNORM*ETA 
TEMP = FKY/SIGMA(K) 
IF (H*DABS(TEMP) .GT. DELTA) TEMP = DSIGN(DELTA/H, TEMP) 
pO 149 I =1, N 
WA1(L) = WA1(L) + TEMP*Q(I,K) 
CONTINUE 
CONTINUE 
COMPUTE THE NORMS OF THE ITERATE AND CORRECTION VECTOR. 
XNORM = 
DIFIT = 
DO 169 IT =1, N 
XNORM = DMAX1(XNORM, DABS (WA1(I) )) 
DIFIT = DMAX1(DIFIT, DABS (X(1)-WA1(I))) 
X(L) = WA1(1) 
CONTINUE 


UPDATE THE BOUND ON THE CORRECTION VECTOR. 

DELTA = DMAX1 (DELTA, SCALE*XNORM) 

DETERMINE THE PROGRESS OF THE ITERATION. 

CONV = (FNORM .LT. FNORM1 .AND. DIFIT .LT. DIFIT1 .AND. 
NSING .EQ. @) 

NIER6 + 1 


NIER7 + 1 
NIER8 + 1 


= 


NIER6 
NIER7 
NIER8 = 


IF (CONV) 


IF (FNORM 


1 


IF (DIFIT 
TESTS FOR 


IF (FNORM 
IF (DIFIT 
IF (FNORM 
IF (INFO 


TESTS FOR 


IF (NFEV 
IF (NSING 
IF (NIER6 
IF (NIER7 
IF (NIER8 
IF (INFO 


ITERATIVE 


IF (.NOT. 
GO TO 


-GE. MAXFEV) INF 


-NE. @) GO TO 


NIER6 = @ 
-LT. FNORM1 .OR. DIFIT .LT. DIFIT1) NIER7 = @ 
.GT. EPS*XNORM) NIER8 = @ 


CONVERGENCE. 
-LE. FTOL) INFO = 1 


-LE. XTOL*XNORM .AND. CONV) INFO = 2 
-LE. FTIOL .AND. INFO .EQ. 2) INFO = 3 


-NE. 0) GO TO 234 


TERMINATION. 


4 
.EQ. N) INFO 
-EQ. 5) INFO 
-EQ. 3) INFO 
-EQ. 4) INFO 


O = 
5 
6 
7 


nou ou wt 


8 
230 


REFINEMENT IS USED IF THE ITERATION IS CONVERGING. 


CONV .OR. DIFIT .GT. P@5*XNORM .OR. MOPT .EQ. 1) 
220 


START ITERATIVE REFINEMENT. 


DO 219 M = 


FNORML 


FNORM = 


DO 19¢ 


2, MOPT 
= FNORM 
ZERO 
K = 1, N 


IFLAG = K 
CALL FCN (N,WA1, FVEC, IFLAG) 


FRY 


NFCALL = 


= FVEC(K) 
NFCALL + 1 


NFEV = NFCALL/N 
IF (IFLAG .LT. @) GO TO 23¢ 
FNORM = DMAX1 (FNORM, DABS (FKY)) 


ITERATIVE REFINEMENT IS TERMINATED IF IT DOES NOT 
GIVE A REDUCTION OF THE RESIDUALS. 


IF (FNORM .LT. FNORM1) GO TO 17¢ 


00002650 
00002660 
000062670 
00002680 
00002690 
00002700 
00002710 
00002726 
009062730 
00002740 
06002750 
00002760 
06002770 
00002780 
06002790 
00902800 
06002810 
00062820 
09002830 
00002840 
00002850 
00002860 
000062870 
06002880 
00902890 
06902900 
99002910 
00002920 
00002936 
00002949 
00002950 
00002960 
06002970 
00002980 
90002999 
06003000 
00003010 
00603020 
0900630630 
000030640 
06003050 
09003060 
000030670 
$000 3080 
009063090 
00003100 
00003110 
06003120 
00003130 
00003140 
09063156 
$900063160 
00003170 
009003180 
00003190 
00003200 
00003210 
06003220 
900032 30 
09003240 
006003250 
06003260 
00003270 
00003280 
00003290 
00003300 
96063310 
069003320 
00003330 
09003340 
00063350 
00003360 
060063370 
09003380 
000063390 
00603400 
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FNORM = FNORML 06003410 

GO TO 22¢ 000603420 

170 CONTINUE 00003436 
TEMP = FKY/SIGMA(K) 60003446 

po 189 T=1, N 00003450 

WA1(I) = WA1(I) + TEMP*Q(I,K) 00003460 

180 CONTINUE 00003470 
199 CONTINUE 9900 3480 

Cc 00003490 
Cc COMPUTE THE NORMS OF THE ITERATE AND CORRECTION VECTOR. 90003500 
C 00003516 
XNORM = ZERO 00003520 

DIFIT = ZERO 06003530 

pO 209 1 =1, N 00003540 

XNORM = DMAX1(XNORM, DABS (WA1(I) )) 96003550 

DIFIT = DMAX1(DIFIT, DABS (X(1)-WA1(I))) 00003560 

X(I) = WA1(I) 00003576 

200 CONTINUE 00003580 

C 09003590 
C STOPPING CRITERIA FOR ITERATIVE REFINEMENT. $000 36060 
C 090036106 
IF (FNORM .LE. FTOL) INFO = 1 $000 3620 

IF (DIFIT .LE. XTOL*XNORM) INFO = 2 0006063630 

IF (FNORM .LE. FTOL .AND. INFO .EQ. 2) INFO = 3 09003640 

IF (NFEV .GE. MAXFEV .AND. INFO .EQ. 6) INFO = 4 90003650 

IF (INFO .NE. @) GO TO 23 09003660 

21¢ CONTINUE 00003676 
22@ CONTINUE 90003680 

Cc 00003690 
Cc END OF THE ITERATIVE REFINEMENT. 06003700 
€c $0003710 
GO TO 20 000063726 

9 00003730 
Cc TERMINATION, EITHER NORMAL OR USER IMPOSED. 00003740 
C 09003756 
23@ CONTINUE 60003760 
IF (IFLAG .LT. @) INFO = IFLAG 90003770 
RETURN 090003780 

Cc 00003790 
Cc LAST CARD OF SUBROUTINE BRENTM. 0060063800 
Cc 00003816 


END 06903826 
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DESCRIPTION 


Introduction 


Homotopy methods (also known as continuation methods or methods of incre- 
mental loading) for computing zeros of nonlinear systems are well known [1, 4- 
11, 13]. In abstract terms a homotopy method is as follows: Let B be a Banach 
space and f: B > B the function whose zero is desired. Let s: B > B be a simple 
function with a known zero. Construct a continuous map (the homotopy) ®: B 
x [0, 1] — B such that ®(x, 0) = s(x) and ®(x, 1) = f(x). Then by solving the 
equation ®(x, A) = 0 in B x [0, 1], one attempts to move from the known zero of 
s(x) (at X = 0) to the unknown zero of f(x) (at A = 1). There is a considerable 
amount of theory concerning when this procedure will work [11], but, in general, 
moving from a zero of s(x) to a zero of f(x) may or may not be possible. 
Sometimes J is treated as an independent variable [4, 11], and sometimes A is a 
dependent variable with arc length or some other parameter as the independent 
variable [7, 9, 10, 13]. 

For the calculation of (Brouwer) fixed points, the supporting theory is much 
more satisfactory. Let B be the closed unit ball (or any compact, convex subset) 
in E”, and let f: B > B be a C” map. Chow et al. [3] have proved the following 
powerful theorem: Define o.:[0, 1) x B— E” by 


palA, x) = A(x — f(x)) + (1 —A)(x — a) 


where f: B — B is a C” map such that the Jacobian matrix of x — f(x) is 
nonsingular at every fixed point of f. Then for almost all a in the interior of B, the 
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set {(A, x)|0=A<1, x EB, pa(A, x) = 0} of zeros of 2 consists of 


(1) a finite number of closed loops (having finite length) in (0, 1) x B; 

(2) a finite number of arcs (having finite length) in (0, 1) X B with endpoints in 
{1} x B; 

(3) a curve of finite length starting at (0, a) and ending at (1, x), where x € B is 
a fixed point of f. 


The curves in (1), (2), and (3) are disjoint and continuously differentiable. 

In other words, with probability 1 there is a zero curve of p.(A, x) emanating 
from (0, a) which reaches a fixed point x of f (at \ = 1). This zero curve is smooth 
and has finite length. Thus computing a fixed point of f merely amounts to 
tracking a (smooth) zero curve of pa(A, x). Note that the asumptions on f(C’ 
smoothness and nonsingularity of the Jacobian matrix of x — f(x) at the fixed 
point) are quite mild considering that global convergence is guaranteed with 
probability 1. 

A brief outline of how the zero curve is followed is given here. Complete details 
of the algorithm and convergence proofs are in [13]. The basic idea, which has 
been used by several authors [7, 9, 10], is to parameterize the zero curve of 
Pa(A, x) by arc length and then solve an initial value problem. The zero curve 
(A(s), x(s)) emanating from (0, a) satisfies 


PalA(s), x(s)) = 0, A(0) = 0, x(0) =a (1) 


and thus is given by the solution of the initial value problem 


d 
qe Parl), x(s)) =0, 


dr dx 
| ds’ ds 
Computing (dA/ds, dx/ds) reduces to finding the kernel of the n X (n + 1) matrix 
[a — f(x), I — ADf(x)] which always has full rank [3, 13]. (Df(x) is the Jacobian 
matrix of f(x).) Therefore there are no “singular points” along the curve. 

Of course the zero curve of pa(A, x) could be followed by a general curve 
tracking program like that of Kubicek [10], but since the ultimate objective is a 
fixed point and not the zero curve of pa, special tactics are called for. There are 
several other reasons for not using the program in [10]. That program produces 
a specified number of data points on the curve, and it would be difficult to make 
it stop exactly at A(s) = 1. Furthermore, the numerical linear algebra and ordinary 
differential equation (ODE) techniques in that program are primitive compared 
with current technology (as, for example, [2] and [12]). 

- Computing Zeros. This algorithm for computing fixed points can be used to 
find zeros also, but then global convergence is not guaranteed. The homotopy 
map for zeros is 


(2) 
=], A(0) = 0, x(0) =a. 


@,(A, x) = Af(x) + (1 = A)(x — a), 


and the rest of the details are similar to the fixed point case. Observe that in the 
fixed point case, the zero curve of pa has finite length (in fact, fairly short for 
practical problems), and thus stiffness of the ODE is never a problem. However, 
the zero curve of ¢,. can (and in practice frequently does) wander off to infinity, 
and the ODE can be stiff. 

There are numerous conditions on f guaranteeing that the zero curve of ®, 
reaches a zero [3, 13], but these are frequently not satisfied for practical problems. 
One such sufficient condition is that for some r > 0, 


xf(x)=O on |xl=r. 


Then f(x) has a zero in the ball || x || = 7, and for almost all a in the interior of this 
ball, there is a zero curve of ®, connecting (0, a) to (1, x), and the Jacobian 
matrix D®, has full rank along this zero curve [13]. 
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In view of the preceding comments, the computer code should be used with 
caution on zero finding problems. 


Organizational Details 


There are seven subroutines: FIXPT, FODE, DCPOSE, INNER, STEP, INTRP, 
and ROOT. The user need only call FIXPT; all the others are directly or 
indirectly used by FIXPT. 

The subroutines STEP, INTRP, and ROOT are from [12]. STEP is used to 
solve the initial value problem, and INTRP and ROOT are used to calculate the 
vector x(s) corresponding to A(s) = 1. FODE specifies the ordinary differential 
equation for STEP. FODE must determine the kernel of a matrix, and it uses 
DCPOSE and INNER for this purpose. DCPOSE was taken from [2] with minor 
modifications. 

FIXPT and FODE contain dimension statements which limit N, and also use 
labeled common. These restrictions could have been avoided by considerably 
lengthening the call lists of STEP, FODE, and FIXPT. Instead we chose to use 
STEP verbatim, so that the user needs only one version of STEP, and future 
improvements in STEP can be easily incorporated into this fixed point package. 
The difficulty arises because FIXPT has parameters which must be passed to 
FODE via STEP, and DCPOSE must return information back up through FODE 
and STEP to FIXPT. 

FIXPT limits the number of steps to 1000, but this can be changed in the 
DATA statement that sets the value of LIMITD. 

FIXPT and FODE contain dimension statements which limit N to 100. 

STEP and ROOT use machine dependent constants, for which appropriate 
DATA statements must be chosen, as explained in the listing. No other modifi- 
cations are required by the user. 

The user must supply two subroutines, F(X, V) and FJAC (X, V, K). Subroutine 
F evaluates f at X and returns the result in (the vector) V. Subroutine FJAC 
evaluates the Kth column of the Jacobian matrix of f at X and returns the result 
in V. FJAC may, of course, produce finite difference approximations to the 
Jacobian matrix. The effect of finite difference approximations on the overall 
efficiency and accuracy of the algorithm has not been explored so far. 


Modifications for Large Sparse Problems. FIXPT was designed for low-di- 
mensional (n <= 100) problems where the Jacobian matrix of fis dense. It is not 
difficult to modify FIXPT for a problem where n is very large but the Jacobian 
matrix of fis sparse. Write the Jacobian matrix of the homotopy map as 


Dpa(x, A) = [I — ADf(x), a — f(x)]. 


Note that the order of the variables has been switched. The subroutine DCPOSE 
essentially reduces Dpa(x, A) to upper triangular form. If Df(x) is sparse, then 
Dpa(x, A) can be reduced to upper triangular form efficiently by, e.g., plane 
rotations. Probably DCPOSE should be tailored to the particular structure of 
Df(x). FODE computes the kernel of the upper triangular matrix produced by 
DCPOSE. This calculation in FODE would have to be changed and again should 
probably be tailored to the particular form of Df(x). Thus FODE and DCPOSE 
would require major changes, but all the other subroutines would remain the 
same (except, of course, for the DIMENSION statements in FIXPT). It might 
also be desirable to reduce the storage requirements of STEP as explained 
in [12]. 


Testing. FIXPT has been tested on several hundred problems of mixed poly- 
nomial, exponential, and trigonometric types, with n ranging from 2 to 100. Some 
problems, for example, an exponential with a rapidly oscillating trigonometric 
exponent, give the method a great deal of difficulty. On the other hand, high- 
degree (£10) polynomials in 100 dimensions are handled easily. When used 
properly, the performance of FIXPT has been entirely satisfactory. The computed 
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Table I 

n ND Arclength FIXPT time ZSYSTM time 

5 52 2.71 0.5 0.5 
10 74 3.73 2.3 17.3* 
15 97 4.49 6.9 + 
20 73 5.16 10.3 + 
25 81 5.70 19.6 + 
30 108 6.19 40.3 + 
35 121 6.65 69.1 + 
40 121 7.08 98.0 + 
45 123 748 134.7 + 
50 129 7.85 187.8 + 


* Did not converge. 
+ No convergence, reported “singular Jacobian.” 


fixed points are usually accurate to within the tolerance EPS and have never 
been in error by more than 10 EPS. Some typical computational results are given 
in [13]. Shown in Table I are the results for Brown’s function 


fis =n- (IL-1), 


i=] 
n 


fix) =~ ( uta) (n+1)) J=2,...,n, 
1 


which was suggested by R. Saigal as a particularly difficult problem (because the 
Jacobian matrix is ill conditioned). ZSYSTM is from the IMSL library and uses 
a quasi-Newton method. ND is the number of Jacobian evaluations, and the CPU 
time is execution time (in seconds) on a CDC 6500. EPS = 1.E—8, ARCTOL = 
1.0E—3 for N = 5, 10, 20, 25, and ARCTOL = 1.0E—5 for N = 15, 30, 35, 40, 45, 50. 
For this problem the zero curve does not turn back, although in the next example 
from [13] the zero curve turns back many times. Therefore, the use of the 
parameter \ as a dependent variable is crucial. 


f(x) = exp(cos( & >, x) k=1,...,5. 


i=] 


Starting from zero, both Steffensen’s method and ZSYSTM failed to find a fixed 
point of f(x). FIXPT required 6.39 seconds of CPU time, 513 Jacobian evaluations, 
with an arc length of 14.83, to compute a fixed point accurate to eight places. 


Referee’s Note. The single precision program given in the listing was run 
successfully in double precision on an IBM 3033, using the AUTODBL feature of 
the Fortran Extended H Compiler. However, the author reports that this worked 
on another system only after the final argument (0.0) in the two references to 
INNER in DCPOSE was changed to double precision. 
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ALGORITHM 
DIMENSION Y(161) 
MAIN PROGRAM AND USER WRITTEN SUBROUTINES FOR THE FUNCTION 


F WHOSE KTH COMPONENT IS 
EXP (COS (K*¥ (X(1)+X(2)+...+X(N)))) 


AQAQAANAAANAN 


N=3 
ARCTOL=1.@E-4 
EPS=1.@E-8 
CALL SECOND (TIME1) 
LFLAG=@ 
CALL FIXPT(N,Y,ARCTOL,EPS,ARCLEN,NFE, [FLAG) 
NP1=N+1 
CALL SECOND (TIME2) 
WRITE (6,30) ARCLEN,IFLAG, (Y(L) ,L=1,NP1) 
30 FORMAT (/11H ARC LENGTH, 1PE18.9, 4X, 4HCODE,13/ (1X, 7E17.9)) 
WRITE (6,406) NFE 
46 FORMAT (/18,21HK JACOBIAN EVALUATIONS/) 
EXTIME=TIME2-TIME1 
WRITE (6,56) EXTIME 
50 FORMAT (22H EXECUTION TIME(SEC) =,F8.2/1H1) 
69 CONTINUE 
STOP 
END 


SUBROUTINE SECOND(T) 
*x*RK THIS IS A DUMMY ROUTINE **4% 


T SHOULD BE SET EQUAL TO A COUNTER COUNTING SECONDS 


OG Oe 


T= 0.0 
RETURN 
END 


SUBROUTINE F(X,V) 


SUBROUTINE TO EVALUATE THE FUNCTION WHOSE JTH COMPONENT IS 
EXP (COS (J*(X(1)+...+X(N)))) 


ON RETURN V CONTAINS F(X) 


ClO 38-0. OE SS OO 


REAL X(10@) ,V(100) 
COMMON /FIXEDP/ YPOLD(1@1) ,A(100) ,NFE,N,NP1, IFLAG 
SUMX=0.0@ 
DO 2@ J=1,N 
20 SUMX=SUMX+X (J) 
DO 36 K=1,N 
30 V (K)=EXP (COS (FLOAT (K) *SUMX) ) 
RETURN 
END 


SUBROUTINE FJAC(X,V,K) 


290 


300 
316 
320 
330 
340 
359 


370 
380 


390 
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OOOO: OnG -@:CrcQ 


EVALUATES THE JACOBIAN MATRIX OF THE FUNCTION WHOSE JTH 
COMPONENT IS 
EXP (COS (J*(X(1)+...+X(N)))) 


ON RETURN V_ CONTAINS THE KTH COLUMN OF THE JACOBIAN MATRIX 
DF (X) 


REAL X(100) ,V(100) 

COMMON /FIXEDP/ YPOLD(1@1) ,A(10@) ,NFE,N,NP1,IFLAG 
IF (K .GT. 1) RETURN 

SUMX=0. @ 

DO 36 J=1,N 


30 SUMX=SUMX+X (J) 
40 DO 6@ J=1,N 


FJ=FLOAT (J) 
ECKX=EXP (COS (FJ*SUMX) ) 


60 V(J)=-FI*SIN (FJ*SUMX) *ECKX 


RETURN 


END OF TEST PROGRAMS. 


RHEE KAKERKEKRERRRERERRRRERRERER RRR RRR RERERRRRRERRRRERERERRRRRRREE 


END 


SUBROUTINE FIXPT(N,Y,ARCTOL,EPS ,ARCLEN ,NFE, FLAG) 


SUBROUTINE FIXPT FINDS A FIXED POINT OR ZERO OF THE 
N-DIMENSIONAL VECTOR FUNCTION F(X). FOR THE FIXED POINT 
PROBLEM F(X) IS ASSUMED TO BE A C2 MAP OF SOME BALL INTO 
ITSELF. THE EQUATION X = F(X) IS SOLVED BY 

FOLLOWING THE ZERO CURVE OF THE HOMOTOPY MAP 


LAMBDA*(X - F(X)) + (1 - LAMBDA)*(X - A) , 
STARTING FROM LAMBDA = @, X = A. THE CURVE IS FARAMETERIZED 
BY ARC LENGTH S, AND IS FOLLOWED BY SOLVING THE ORDINARY 


DIFFERENTIAL EQUATION D(HOMOTOPY MAP)/DS = @ FOR 
Y¥(S) = (LAMBDA(S), X(S)). 


FOR THE ZERO FINDING PROBLEM F(X) IS ASSUMED TO BE A C2 MAP 


SUCH THAT FOR SOME R .GT. @, X*F(X) .GE. @ WHENEVER NORM(X) = R. 


THE EQUATION F(X) = @ IS SOLVED BY FOLLOWING THE ZERO CURVE 
OF THE HOMOTOPY MAP 


LAMBDA*F(X) + (1 - LAMBDA)*(X - A) 
EMANATING FROM LAMBDA = @, X = A. 
A MUST BE AN INTERIOR POINT OF THE ABOVE MENTIONED BALLS, 


THIS CODE IS BASED ON THE ALGORITHM IN L. T. WATSON, A 
GLOBALLY CONVERGENT ALGORITHM FOR COMPUTING FIXED POINTS OF 
C2 MAPS, APPL. MATH. COMPUT., 1978. 


THE USER MUST SUPPLY A SUBROUTINE F(X,V) WHICH EVALUATES 
F(X) AT X AND RETURNS THE VECTOR F(X) IN V, AND A SUBROUTINE 
FJAC(X,V,K) WHICH RETURNS IN V THE KTH COLUMN OF THE 
JACOBIAN MATRIX OF F(X) EVALUATED AT X. FIXPT DIRECTLY OR 
INDIRECTLY USES THE SUBROUTINES STEP , INTRP , ROOT , FODE , 


F , FJAC , DCPOSE , AND THE FUNCTION INNER . FIXPT AND 


FODE CONTAIN DIMENSION STATEMENTS WHICH LIMIT N TO 16@. 
STEP AND ROOT CONTAIN MACHINE DEPENDENT CONSTANTS. NO 
OTHER MODIFICATIONS BY THE USER ARE REQUIRED. 


ON INPUT: 


N IS THE DIMENSION OF X AND F(X). 


406 
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ANAAAAAAAAAAAAAAAAARAAAAAANAAAARANRAAANQAAANAAANAANRQAANAQAAARAARAANAANAANANAAARANRAARAARAARAANAANANAANAAANDAA|AAA 


Y IS AN ARRRAY OF LENGTH N+1. (Y¥(2),...,Y¥(N+1)) = A IS THE 


STARTING POINT FOR THE ZERO CURVE. 


ARCTOL IS THE LOCAL ERROR ALLOWED THE ODE SOLVER WHEN 
FOLLOWING THE ZERO CURVE. IF ARCTOL .LE. @.0 ON INPUT 
IT IS RESET TO .5*SQRT(EPS). NORMALLY ARCTOL SHOULD 
BE CONSIDERABLY LARGER THAN EPS. 


EPS IS THE LOCAL ERROR ALLOWED THE ODE SOLVER WHEN VERY 
NEAR THE FIXED POINT(ZERO). EPS IS APPROXIMATELY THE 
ABSOLUTE ERROR IN THE COMPUTED FIXED POINT(ZERO). 


IFLAG CAN BE -1, 6, 2, OR 3. IFLAG SHOULD BE @ ON THE FIRST 


CALL TO FIXPT FOR THE PROBLEM X=F(X), AND -1 FOR THE 
PROBLEM F(X)=@. IN CERTAIN SITUATIONS IFLAG IS SET TO 
2 OR 3 BY FIXPT, AND FIXPT CAN BE CALLED AGAIN WITHOUT 
CHANGING IFLAG. 


Y, ARCTOL, EPS, ARCLEN, NFE, AND IFLAG SHOULD ALL BE 

VARIABLES IN THE CALLING PROGRAM. 

ON OUTPUT: 

N IS UNCHANGED. 

Y(1) = LAMBDA, (Y¥(2),...,Y(N+1)) = X, AND Y IS AN APPROXIMATE 
ZERO OF THE HOMOTOPY MAP. NORMALLY LAMBDA = 1 AND X IS A 
FIXED POINT(ZERO) OF F(X). IN ABNORMAL SITUATIONS LAMBDA 
MAY ONLY BE NEAR 1 AND X IS NEAR A FIXED POINT(ZERO). 

ARCTOL = EPS AFTER A NORMAL RETURN (IFLAG = 1). 


EPS IS UNCHANGED AFTER A NORMAL RETURN (IFLAG = 1). IT IS 
INCREASED TO AN APPROPRIATE VALUE ON THE RETURN IFLAG = 2. 


ARCLEN IS THE LENGTH OF THE PATH FOLLOWED. 


NFE IS THE NUMBER OF FUNCTION EVALUATIONS (= NUMBER OF 
JACOBIAN EVALUATIONS). 


TIFLAG = 
-1 CAUSES FIXPT TO INITIALIZE EVERYTHING FOR THE PROBLEM 
F(X) = @ (USE ON FIRST CALL). 


) CAUSES FIXPT TO INITIALIZE EVERYTHING FOR THE PROBLEM 
X = F(X) (USE ON FIRST CALL). 


1 NORMAL RETURN. 

2 SPECIFIED ERROR TOLERANCE CANNOT BE MET. EPS HAS BEEN 
INCREASED TO A SUITABLE VALUE. TO CONTINUE, JUST CALL 
FIXPT AGAIN WITHOUT CHANGING ANY PARAMETERS. 


3. STEP HAS BEEN CALLED 1000 TIMES. TO CONTINUE, CALL 
FIXPT AGAIN WITHOUT CHANGING ANY PARAMETERS. 


4 JACOBIAN MATRIX DOES NOT HAVE FULL RANK. THE ALGORITHM 


HAS FAILED (THE ZERO CURVE OF THE HOMOTOPY MAP CANNOT BE 


FOLLOWED ANY FURTHER). 


5 EPS (OR ARCTOL ) IS TOO LARGE. THE PROBLEM SHOULD BE 
RESTARTED BY CALLING FIXPT WITH A SMALLER EPS (OR 
ARCTOL ) AND IFLAG = @ (-1). 


6 I - DF(X) IS NEARLY SINGULAR AT THE FIXED POINT(DF(X) IS 


NEARLY SINGULAR AT THE ZERO). ANSWER MAY NOT BE 
ACCURATE. 


7 ILLEGAL INPUT PARAMETERS, A FATAL ERROR. 


460 
470 
480 
490 
560 
510 
520 
530 
540 
550 
560 
570 
580 
590 
600 
610 
620 
630 
640 
650 
660 
670 
680 
690 
700 
710 
720 
73@ 
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750 
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77 
780 
790 
800 
81¢ 
826 
830 
840 
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860 
870 
880 
890 
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920 
930 
940 
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960 
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980 
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16066 
1610 
162¢ 
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1640 
1656 
1060 
1670 
1080 
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110¢ 
1110 
1126 
1130 
114 
1150 
1160 
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C 1170 
G *#*k*kk* ARRAY DECLARATIONS. ¥***** 1180 
C 1190 
C THE FOLLOWING ARRAYS ARE FOR A MAXIMUM OF N = 106@ VARIABLES. 1200 
C TO HANDLE UP TO N VARIABLES, CHANGE EACH 1¢@ AND 161 TO N 1210 
C AND N+ 1 RESPECTIVELY. 1226 
C 1230 
C ARRAYS NEEDED BY THE ODE SUBROUTINE STEP . 12406 
REAL Y(101) ,WT (101) ,PHI (101,16) ,P(101) ,YP(1@1) ,PSI(12) 1250 

C 1266 
COMMON /FIXEDP/ YPOLD(1@1) ,A(16@) ,NFEC,NC,NP1,IFLAGC 1270 

Cc 1286 
C ***k* END OF DIMENSIONAL INFORMATION. ****% 1296 
C 136@ 
EXTERNAL FODE 1310 
LOGICAL START ,CRASH,ST99 1320 

Cc 1330 
C LIMITD IS AN UPPER BOUND ON THE NUMBER OF STEPS. IT MAY BE 1340 
C CHANGED BY CHANGING THE FOLLOWING DATA STATEMENT: 1350 
DATA LIMITD/100@/ 1360 

Cc 1370 
C 1380 
Get Use. cei ote st Mh, ee SS ee Te ee SR ee ee 1396 
IF (N .LE. @ .OR. EPS .LE. @.0) IFLAG=7 1460 

IF (IFLAG .LE. ¢) GO TO 10 1410 

IF (IFLAG .EQ. 2) GO TO 35 1426 

IF (IFLAG .EQ. 3) GO TO 30 1430 

C ONLY VALID INPUT FOR IFLAG IS -1, @, 2, 3. 1440 
IFLAG=7 1456 
RETURN 1460 

G 1476 
C **ek* TNITIALIZATION BLOCK, ***** 1480 
Cc 1499 
1¢ ARCLEN=@.@ 1500 
S=90.@ 1510 

IF (ARCTOL .LE. @.@) ARCTOL=.5*SQRT(EPS) 1526 
NFEC=@ 1530 

NC=N 1546 
LFLAGC=IFLAG 1550 
NP1=N+1 1560 

SQNP L=SQRT (FLOAT (NP1) ) 1570 
CURTOL=.@1/SQNP1 158¢ 
ST99=.FALSE. 159¢ 
START=.TRUE. 1600 
CRASH=.FALSE. 16190 

H=.1 162¢ 
EPSSTP=ARCTOL 163¢ 

C SET INITIAL CONDITIONS FOR ORDINARY DIFFERENTIAL EQUATION. 164@ 
YPOLD(1)=1.0 1650 
¥(1)=0.¢@ 166¢ 
WT(1)=1.6 1670 

DO 26 J=2,NP1 1680 
YPOLD(J)=@.@ 1690 
A(J-1)=¥ (J) 1760 
WI(J)=1.@ 1710 

2¢ CONTINUE 1720 
36 LIMIT=LIMITD 1730 
C 174¢ 
C **k*k* END OF INITIALIZATION BLOCK, ****% 1756 
Cc 1760 
C 1770 
C *kk*kk MAIN LOOP. *xxkxk* 1780 
C : 179¢ 
35 DO 15@ ITER=1,LIMIT 1800 
IF (Y(1) .GE. ¢.6) GO TO 5¢@ 1816 

40 IFLAG=5 1820 
RETURN 183 

50 IF (S .LE. 7.0*SQNP1) GO TO 8¢ 1846 
C ARC LENGTH IS GETTING TOO LONG, THE PROBLEM WILL BE 185¢ 
C RESTARTED WITH A DIFFERENT A VECTOR. 186 
ARCLEN=ARCLEN+S 1876 

S=0.0 1880 

60 START=.TRUE. 189¢ 
CRASH=.FALSE. 1900 

C COMPUTE A NEW A VECTOR. 191¢ 


CALL F(Y(2),YP) 1926 
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DO 7@ JW=1,N 1930 
AOLD=A (JW) 1940 

IF (IFLAGC .LT. @) 1950 

+ A(JW)=¥(1)*YP(JW)/(1.@ - Y(1)) + Y(JWH1) 1960 

IF (IFLAGC .EQ. ) 1970 

+ A(JW)=(Y¥(JW+1) - Y(1)*YP(JW))/(1.@ - Y(1)) 198@ 

IF (ABS(A(JW)-AOLD) .GT. .95) GO TO 4@ 1990 

76 CONTINUE 2000 
GO TO 100 2010 

86 IF (¥(1) .LE. .99 .OR. ST99) GO TO 100 2020 
C WHEN LAMBDA REACHES .99, THE PROBLEM WILL BE RESTARTED WITH 2030 
C A NEW A VECTOR. 2040 
90 ST99=.TRUE. 2050 
EPSSTP=EPS 2060 
ARCTOL=EPS 20670 

GO TO 66 2080 

Cc 2690 
C TAKE A STEP ALONG THE CURVE. 2100 
190 CALL STEP(S,Y,FODE,NP1,H,EPSSTP,WT,START,HOLD,K,KOLD, CRASH, 211¢ 
+ PHI,P,YP,PSI) 2120 
NFE=NFEC 213¢ 

C CHECK IF THE STEP WAS SUCCESSFUL. 2140 
IF (IFLAGC .NE. 4) GO TO 12@ 2150 
IFLAG=4 216¢ 
RETURN 2170 

120 IF (.NOT. CRASH) GO TO 130 2180 
C RETURN CODE FOR ERROR TOLERANCE TOO SMALL. 2196 
IFLAG=2 22060 

C CHANGE ERROR TOLERANCES. 2216 
EPS=EPSSTP 2220 

IF (ARCTOL .LT. EPS) ARCTOL=EPS 2230 

C CHANGE LIMIT ON NUMBER OF ITERATIONS. 2240 
LIMS=LIMIT+ITER 2250 

GO TO 226 2260 

Cc 2270 
13@  EPSSTP=ARCTOL 2280 
IF (ABS(YP(1)) .LE. CURTOL) EPSSTP=EPS 2290 

IF (Y¥(1) .LT. 1.0) GO TO 159 2300 

IF (ST99) GO TO 16¢ 2310 

Cc 2320 
C IF LAMBDA .GE. 1.@ BUT THE PROBLEM HAS NOT BEEN RESTARTED 2330 
C WITH A NEW A VECTOR, BACK UP AND RESTART. 2340 
Cc 2350 
$99=S-.5*HOLD 2360 

C GET AN APPROXIMATE ZERO Y(S) WITH Y(1)=LAMBDA .LT. 1.@ 2370 
135 CALL INTRP(S,Y,S99,WT,P,NP1,KOLD,PHI,PSI) 2380 
IF (WI(1) .LT. 1.6) GO TO 14¢ 23990 
S$99=,5*(S-HOLD+S99) 2400 

GO TO 135 2410 

C 2420 
14@ DO 144 JUDY=1,NP1 2430 
Y (JUDY ) =WT (JUDY) 2440 

YPOLD (JUDY )=P (JUDY) 2450 

144 WT(JUDY)=1.¢ 2460 
S=S99 2470 

GO TO 90 2480 

C 2490 
15@ CONTINUE 2500 
Cc 2510 
C *kkkk END OF MAIN LOOP. ***#x* 2520 
C 2530 
C LAMBDA HAS NOT REACHED 1 IN 1000 STEPS. 2540 
IFLAG=3 2550 
RETURN 2560 

C 2570 
C 2580 
C USE INVERSE INTERPOLATION TO GET THE ANSWER AT LAMBDA = 1.0. 2590 
C 2600 
16¢@  SA=S-HOLD 2610 
SB=S 2626 
LCODE=1 2630 

176 CALL ROOT(SOUT,Y1SOUT,SA,SB,EPS,EPS,LCODE) 2640 
C ROOT FINDS S SUCH THAT Y(1)(S) = LAMBDA = 1. 2650 
IF (LCODE .GT. @) GO TO 199 2660 

CALL INTRP(S,Y,SOUT,WT,P,NP1,KOLD,PHI,PSI) 2670 


YISOUT=WT(1)-1.@ 2680 
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190 


GO TO 170 
LFLAG=1 


C SET IFLAG = 6 IF ROOT COULD NOT GET LAMBDA = 1.@ 


IF (LCODE .GT. 2) IFLAG=6 
ARCLEN=ARCLEN+5SA 


C LAMBDA(SA) = 1.@. 


AAAAMAANAAANNANA 


Q 


CALL INTRP(S,Y,SA,WT,P,NP1,KOLD,PHI,PSI) 


DO 21¢ J=1,NP1 
Y(J)=WT (J) 
RETURN 
LIMIT=LIMS 
RETURN 

END 


SUBROUTINE FODE(S,Y,YP) 


SUBROUTINE FODE IS USED BY SUBROUTINE STEP TO SPECIFY THE 
ORDINARY DIFFERENTIAL EQUATION DY/DS = G(S,Y) , WHOSE SOLUTION 
IS THE ZERO CURVE OF THE HOMOTOPY MAP. S = ARC LENGTH, 

YP 


= DY/DS, AND Y(S) = (LAMBDA(S), X(S)) 


*kKKK ARRAY DECLARATIONS. ***xx 


THE FOLLOWING ARRAYS ARE FOR A MAXIMUM OF N = 1066 VARIABLES. 
TO HANDLE UP TO N VARIABLES, CHANGE EACH 1¢@ AND 161 TO N 
AND N + 1 RESPECTIVELY. 


REAL Y(1),YP(1) 


ARRAYS FOR COMPUTING THE JACOBIAN MATRIX AND ITS KERNAL. 


REAL QR(106@,101) ,ALPHA(1@@) ,TZ (161) 
INTEGER PIVOT(1@1) 


REAL INNER 
COMMON /FIXEDP/ YPOLD(1@1) ,A(106@) ,NFE,N,NP1, I FLAG 
NDIM=10@ 


C 
C ***** END OF DIMENSIONAL INFORMATION. ****% 
C 


© 030 1-0) C2 


160 


11¢ 
12¢ 


C 
C 
C 
146 
156 


160 
170 
C 
C 


NFE=NFE+1 


NFE CONTAINS THE NUMBER OF JACOBIAN EVALUATIONS. 


* * * * * * k * * * * * * * * * 


COMPUTE THE JACOBIAN MATRIX, STORE IT IN QR. 


QR = ( A - F(X), I - LAMBDA*DF(X) ) 


CALL FC(Y(2),TZ) 
IF (IFLAG .LT. 6) GO TO 14@ 
DO 10@ J=1,N 
QR(J,1)=A(J)-TZ(J) 
DO 126 K=1,N 
CALL FJAC(Y(2) ,TZ,K) 
KP1=K+1 
DO 11@ J=1,N 
QR(J,KP1)=-¥ (1) *TZ(J) 
QR(K,KP1)=1.@+QR(K,KP1) 
GO TO 1¢ 


QR = ( F(X) - X + A, LAMBDA*DF(X) + (1 - LAMBDA)4I ) 


DO 150 J=1,N 
QR(J,1)=TZ(J)-Y¥ (J+1)+A(J) 
DO 176 K=1,N 
CALL FJAC(Y(2),TZ,K) 
KP1=K+1 
DO 16@ J=1,N 
QR(J,KP1)=¥ (1) *TZ (J) 
QR(K,KP1)=1.4-Y¥ (1)+QR(K,KP1) 


* * * * * * * * * * * * * * * * 


C REDUCE THE JACOBIAN MATRIX TO UPPER TRIANGULAR JORM. 


10 


CALL DCPOSE(NDIM,N,QR, ALPHA, PIVOT, IERR,TZ,YP) 
IF (IERR .EQ. 6) GO TO 26 
LFLAG=4 


2690 
2700 
2710 
272 
2730 
2740 
2750 
2760 
2770 
2780 
2790 
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2820 
2830 
2840 
2850 
2860 
2870 
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2896 
2900 
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2950 
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2976 
2980 
2999 
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3030 
3040 
3650 
3060 
3070 
3080 
3096 
3100 
3110 
3120 
3130 
3146 


3156 


3160 
3170 
3180 
319¢ 
3200 
321¢ 
3220 
3230 
3246 
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3300 
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RETURN 


C COMPUTE KERNAL OF JACOBIAN, WHICH SPECIFIES YP=DY/DS. 


20 


36 
40 


6¢ 


70 
C 


TZ(NP1)=1.0 
DO 4@ LW=1,N 
I=NP1-LW 
IK=I+1 
SUM=@.0 
DO 3@ J=IK,NP1 
SUM=SUM+QR(1,J)*TZ(J) 
TZ (1)=-SUM/ALPHA (1) 
YPNORM=SQRT (INNER(1,NP1,TZ,TZ,@.0) ) 
DO 6@ K=1,NP1 
KPIV=P LVOT (K) 
YP (KPIV)=TZ(K) /YPNORM 
IF (INNER(1,NP1,YP,YPOLD,@.6) .GE. @.0) GO TO 8@ 
DO 7@ I=1,NP1 
YP(I)=-YP (I) 


C SAVE CURRENT DERIVATIVE (= TANGENT VECTOR) IN YPOLD 


80 
99 


1¢ 
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20 


49 


50 


DO 9@ I=1,NP1 
YPOLD (I)=YP (I) 
RETURN 

END 


REAL FUNCTION INNER(K,M,A,B,C) 
DIMENSION A(1),B(1) 

SUM=C 

DO 10 I=K,M 

SUM=SUM+A (1) *B (1) 

INNER=SUM 

RETURN 

END 


SUBROUTINE DCPOSE(NDIM,N,QR,ALPHA, PIVOT, IERR,Y,SUM) 


SUBROUTINE DCPOSE IS A MODIFICATION OF THE ALGOL PROCEDURE 
DECOMPOSE IN P. BUSINGER AND G. H. GOLUB, LINEAR LEAST 


SQUARES SOLUTIONS BY HOUSEHOLDER TRANSFORMATIONS, 
NUMER. MATH. 7 (1965) 269-276. 


INTEGER NDIM,N,PIVOT (1) 
REAL QR(NDIM, 1) ,ALPHA(N) 
INTEGER ITERR,I,J,JBAR,K 
REAL BETA, SIGMA, ALPHAK,QRKK,Y (1) ,SUM(1) 
REAL INNER 
IERR=@ 
NP1=N+1 
DO 2@ J=1,NP1 
SUM(J)=INNER(1 »N,QR(1,J) »QR(1,J) »9.0) 
PIVOT (J)=J 
DO 5@@ K=1,N 
SIGMA=SUM(K) 
JBAR=K 
KP1=K+1 
DO 4@ J=KP1,NP1 
IF (SIGMA .GE. SUM(J)) GO TO 4@ 
SIGMA=SUM(J) 
JBAR=J 
CONTINUE 
IF (JBAR .EQ. K) GO TO 7@ 
I=PIVOT (K) 
PIVOT (K)=PIVOT (JBAR) 
PIVOT (JBAR)=I1 
SUM(JBAR)=SUM(K) 
SUM(K)=SIGMA 
DO 5@ I=1,N 
STGMA=QR(1L,K) 
QR(I,K)=QR(1,JBAR) 
QR(L,JBAR)=SIGMA 
CONTINUE 
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60 


80 
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END OF COLUMN INTERCHANGE. 
SLGMA=INNER (K,N,QR(1,K) ,QR(1,K) ,6.0) 
IF (SIGMA .NE. 6.0) GO TO 60 
TERR=1 

RETURN 

IF (K .EQ. N) GO TO 560 

QRKK=QR (K,K) 

ALPHAK=-SQRT (SIGMA) 

IF (QRKK .LT. @.@) ALPHAK=-ALPHAK 
ALPHA (K) =ALPHAK 

BETA=1.06/ (SIGMA-QRKK*ALPHAK ) 
QR(K,K)=QRKK-ALPHAK 

DO 8@ J=KP1,NP1 


Y (J)=BETA*INNER(K,N,QR(1,K),QR(1,J) ,@.0) 


DO 100 J=KP1,NP1 
DO 9@ I=K,N 
QR(1I,J)=QR(1,J)-QR(I,K)*¥ (J) 
CONTINUE 
SUM(J)=SUM(J)-QR(K, J) **2 


CONTINUE 
CONTINUE 
ALPHA (N)=QR(N,N) 
RETURN 


END 


SUBROUTINE STEP(X,Y,F,NEQN,H,EPS,WT, START, 
1 HOLD,K,KOLD,CRASH,PHI,P,YP,PSI) 


SUBROUTINE STEP 


INTEGRATES A SYSTEM OF FIRST ORDER ORDINARY 


DIFFERENTIAL EQUATIONS ONE STEP NORMALLY FROM X TO X+H, USING A 
MODIFIED DIVIDED DIFFERENCE FORM OF THE ADAMS PECE FORMULAS. LOCAL 
EXTRAPOLATION IS USED TO IMPROVE ABSOLUTE STABILITY AND ACCURACY. 
THE CODE ADJUSTS ITS ORDER AND STEP SIZE TO CONTROL THE LOCAL ERROR 


PER UNIT STEP IN A GENERALIZED SENSE. 


SPECIAL DEVICES ARE INCLUDED 


TO CONTROL ROUNDOFF ERROR AND TO DETECT WHEN THE USER IS REQUESTING 
TOO MUCH ACCURACY. 


THIS CODE IS COMPLETELY EXPLAINED AND DOCUMENTED IN THE TEXT, 
COMPUTER SOLUTION OF ORDINARY DIFFERENTIAL EQUATIONS& THE INITIAL 


VALUE PROBLEM BY L. F. SHAMPINE AND M. 


THE PARAMETERS REPRESENT& 
X -- INDEPENDENT VARIABLE 


¥(*) 


-- SOLUTION VECTOR AT X 


K. GORDON. 


YP(*) -- DERIVATIVE OF SOLUTION VECTOR AT X AFTER SUCCESSFUL 


STEP 


NEQN -- NUMBER OF EQUATIONS TO BE INTEGRATEL 
H -- APPROPRIATE STEP SIZE FOR NEXT STEP. 


EPS -- LOCAL ERROR TOLERANCE. 


CODE 


NORMALLY DETERMINED BY 


MUST BE VARIABLE 


WT(*) -- VECTOR OF WEIGHTS FOR ERROR CRITERION 
START -- LOGICAL VARIABLE SET .TRUE. FOR FIRST STEP, .FALSE. 


OTHERWISE 


HOLD -~ STEP SIZE USED FOR LAST SUCCESSFUL STEP 
K -- APPROPRIATE ORDER FOR NEXT STEP (DETERMINED BY CODE) 
KOLD -- ORDER USED FOR LAST SUCCESSFUL STEP 
CRASH -~ LOGICAL VARIABLE SET .TRUE. WHEN NO STEP CAN BE TAKEN, 


THE ARRAYS 


INTRP. 


-FALSE. OTHERWISE 


THE ARRAY P IS INTERNAL TO THE CODE. 


INPUT TO STEP 


FIRST CALL -- 


PHI, PSI ARE REQUIRED FOR THE INTERPOLATION SUBROUTINE 


THE USER MUST PROVIDE STORAGE IN HIS DRIVER PROGRAM FOR ALL ARRAYS 
IN THE CALL LIST, NAMELY 


DIMENSION Y (NEQN) ,WT(NEQN) , PHI (NEQN, 16) ,P (NEQN) , YP (NEQN) , PSI (12) 


THE USER MUST ALSO DECLARE START AND CRASH LOGICAL VARIABLES 
AND F AN EXTERNAL SUBROUTINE, SUPPLY THE SUBROUTINE F(X,Y,YP) 
TO EVALUATE 

DY(I)/DX = YP(I) = F(X,Y(1),Y¥(2),...,Y(NEQN)) 


4226 
4236 
4240 
4250 
4260 
4270 
4280 
4296 
43006 
4310 
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4340 
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4360 
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AND INITIALIZE ONLY THE FOLLOWING PARAMETERS& 
X -- INITIAL VALUE OF THE INDEPENDENT VARIABLE 
Y(*) -- VECTOR OF INITIAL VALUES OF DEPENDENT VARIABLES 
NEQN -- NUMBER OF EQUATIONS TO BE INTEGRATED 
H -- NOMINAL STEP SIZE INDICATING DIRECTION OF INTEGRATION 

AND MAXIMUM SIZE OF STEP. MUST BE VARIABLE 

EPS -- LOCAL ERROR TOLERANCE PER STEP. MUST BE VARIABLE 
WI(*) -- VECTOR OF NON-ZERO WEIGHTS FOR ERROR CRITERION 
START -- .TRUE. 


STEP REQUIRES THE L2 NORM OF THE VECTOR WITH COMPONENTS 

LOCAL ERROR(L)/WT(L) BE LESS THAN EPS FOR A SUCCESSFUL STEP. THE 

ARRAY WT ALLOWS THE USER TO SPECIFY AN ERROR TEST APPROPRIATE 

FOR HIS PROBLEM. FOR EXAMPLE, 

WI(L) = 1.@ SPECIFIES ABSOLUTE ERROR, 
=ABS(Y(L)) ERROR RELATIVE TO THE MOST RECENT VALUE OF THE 
L-TH COMPONENT OF THE DERIVATIVE, 

AMAX1 (WT(L) ,ABS(Y(L))) ERROR RELATIVE TO THE LARGEST 
MAGNITUDE OF L-TH COMPONENT OBTAINED SO FAR, 

ABS (Y¥ (L) )*RELERR/EPS + ABSERR/EPS SPECIFIES A MIXED 
RELATIVE-ABSOLUTE TEST WHERE RELERR IS RELATIVE 
ERROR, ABSERR IS ABSOLUTE ERROR AND EPS = 
AMAX1 (RELERR, ABSERR) 


SUBSEQUENT CALLS -- 


SUBROUTINE STEP IS DESIGNED SO THAT ALL INFORMATION NEEDED TO 
CONTINUE THE INTEGRATION, INCLUDING THE STEP SIZE H AND THE ORDER 
K, IS RETURNED WITH EACH STEP. WITH THE EXCEPTION OF THE STEP 
SIZE, THE ERROR TOLERANCE, AND THE WEIGHTS, NONE OF THE PARAMETERS 
SHOULD BE ALTERED. THE ARRAY WT MUST BE UPDATED AFTER EACH STEP 
TO MAINTAIN RELATIVE ERROR TESTS LIKE THOSE ABOVE. NORMALLY THE 
INTEGRATION IS CONTINUED JUST BEYOND THE DESIRED ENDPOINT AND THE 
SOLUTION INTERPOLATED THERE WITH SUBROUTINE INTRP. IF IT IS 
IMPOSSIBLE TO INTEGRATE BEYOND THE ENDPOINT, THE STEP SIZE MAY BE 
REDUCED TO HIT THE ENDPOINT SINCE THE CODE WILL NOT TAKE A STEP 
LARGER THAN THE H INPUT. CHANGING THE DIRECTION OF INTEGRATION, 
I.E., THE SIGN OF H, REQUIRES THE USER SET START = .TRUE. BEFORE 
CALLING STEP AGAIN. THIS IS THE ONLY SITUATION IN WHICH START 
SHOULD BE ALTERED. 


OUTPUT FROM STEP 
SUCCESSFUL STEP -- 


THE SUBROUTINE RETURNS AFTER EACH SUCCESSFUL STEP WITH START AND 
CRASH SET .FALSE. . X REPRESENTS THE INDEPENDENT VARIABLE 
ADVANCED ONE STEP OF LENGTH HOLD FROM ITS VALUE ON INPUT AND Y 
THE SOLUTION VECTOR AT THE NEW VALUE OF X . ALL OTHER PARAMETERS 
REPRESENT INFORMATION CORRESPONDING TO THE NEW X NEEDED TO 
CONTINUE THE INTEGRATION. 


UNSUCCESSFUL STEP -- 


WHEN THE ERROR TOLERANCE IS TOO SMALL FOR THE MACHINE PRECISION, 
THE SUBROUTINE RETURNS WITHOUT TAKING A STEP AND CRASH = .TRUE. 

AN APPROPRIATE STEP SIZE AND ERROR TOLERANCE ,FOR CONTINUING ARE 
ESTIMATED AND ALL OTHER INFORMATION IS RESTORED AS UPON INPUT 
BEFORE RETURNING. TO CONTINUE WITH THE LARGER TOLERANCE, THE USER 
JUST CALLS THE CODE AGAIN. A RESTART IS NEITHER REQUIRED NOR 
DESIRABLE. 


LOGICAL START, CRASH, PHASE1, NORND 

DIMENSION Y(NEQN) , WI (NEQN) , PHI (NEQN, 16) ,P (NEQN) , YP (NEQN) , PSI (12) 
DIMENSION ALPHA(12) ,BETA(12) ,SIG(13) ,W(12) ,V(12) ,G(13), 

1 GSTR(13),TWO(13) 

EXTERNAL F 
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5286 
5290 
53006 
5310 
5320 
5330 
5340 
5350 
5360 
5370 
5380 
5396 
5400 
5410 
5420 
5430 
5440 
5450 
5460 
5470 
5480 
5490 
5500 
5510 
5526 
5530 
5540 
5556 
5560 
557@ 
5580 
5596 
5600 
5616 
5620 


CRERKKKKRRKRRRER RRR RR RER RR RRER ER ER ER REER ER ER ER RR ERE RER ERE ERE RRR REERERE 56, 3G) 


c* 
cx 
cx 
Cx 
cx 
Cx 
Cx 
Cc* 


THE ONLY MACHINE DEPENDENT CONSTANTS ARE BASED ON THE MACHINE UNIT 
ROUNDOFF ERROR U WHICH IS THE SMALLEST POSITIVE NUMBER SUCH THAT 
1.Q4U .GT. 1.0 . THE USER MUST CALCULATE U AND INSERT 
TWOU=2.6*U AND FOURU=4.0*U IN THE DATA STATEMENT BEFORE CALLING 
THE CODE. THE ROUTINE MACHIN CALCULATES U. 
FOR THE CDC 6500, 6600, 7600 -- 

DATA TWOU,FOURU /164246600060600060000B , 16434966006000000000B/ 
FOR THE IBM 366/370 (SINGLE PRECISION) -- 


*5640 
*5650 
*5660 
*5670 

5680 
* 
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COLLECTED ALGORITHMS (cont.) 


Cc* 
cx 
Cx 
cx 
Cc* 
cx 
cx 


DATA TWOU,FOURU /Z3C200600,Z3C460000/ 


FOR THE IBM 360/370 (DOUBLE PRECISION) -- 


DATA TWOU,FOURU /23420660000006000 , 23440006000000000/ 


FOR THE UNIVAC 1148 AND HONEYWELL 64¢@ -- 


DATA TWOU,FOURU /2.0**(-25) ,2.0**(-24)/ 


FOR THE PDP-11 -- 


DATA TWOU,FOURU /2.0**(-22),2.@**(-21)/ 


CRHERKARERKKKRRKERERERRERERRERRREKERR EE RRRERERRRERERERERRERRRRRERERERERRERER 5 QQ 


ANANQNAQAAARAAAN 


aaa 


C 
C 
C 


CHGS CY CP oY 


DATA TWO/2.6,4.6,8.0, 16.0, 32.6,64.0,128.0, 256.0,512.0,1024.@, 


L 2048.0,4096.@, 8192.6/ 
DATA GSTR/@. 500, @.6833,0.0417,90.0264,0.6188,0.0143,0.0114,0.00936, 5736 
1 0.00789 ,6.00679,0.00592,6.00524,0.06468/ 


DATA G(1),G(2)/1.0,@.5/,SIG(1)/1.6/ 


AK BEGIN BLOCK @ 


CHECK IF STEP SIZE OR ERROR TOLERANCE IS TOO SMALL FOR MACHINE 
PRECISION. IF FIRST STEP, INITIALIZE PHI ARRAY AND ESTIMATE A 
STARTING STEP SIZE. 


KKK 


IF STEP SIZE IS TOO SMALL, DETERMINE AN ACCEFTABLE ONE 


5 


IF ERROR TOLERANCE IS TOO SMALL, INCREASE IT TO AN ACCEPTABLE VALUE 


1¢ 


15 


CRASH = .TRUE. 

IF (ABS (H) .GE. FOURU*ABS(X)) GO TO 5 
H = SIGN(FOURU*ABS (X) ,H) 

RETURN 

P5EPS = @.5*EPS 


ROUND = @.¢ 
DO 1¢ L = 1,NEQN 
ROUND = ROUND + (Y(L)/WT(L))**2 
ROUND = TWOU*SQRT (ROUND) 
IF(P5EPS .GE. ROUND) GO TO 15 
EPS = 2.@*ROUND*(1.@ + FOURU) 
RETURN 
CRASH = .FALSE. 
IF(.NOT.START) GO TO 99 


INITIALIZE. COMPUTE APPROPRIATE STEP SIZE FOR FIRST STEP 


20 


25 
99 


CALL F(X,Y,YP) 
SUM = 0.@ 
DO 2¢@ L = 1,NEQN 
PHI(L,1) = YP(L) 
PHI(L,2) = 6.0 
SUM = SUM + (YP(L)/WTI(L))**2 
SUM = SQRT(SUM) 
ABSH = ABS(H) 
IF(EPS .LT. 16.0*SUM*H*H) ABSH = @.25*SQRT(EPS/SUM) 
H = SIGN(AMAX1 (ABSH, FOURU*ABS (X) ) ,H) 
HOLD = @.0@ 
K=l1 
KOLD = @ 
START = .FALSE. 
PHASE] = .TRUE. 
NORND = .TRUE. 
IF(P5EPS .GT. 16¢.@*ROUND) GO TO 99 
NORND = .FALSE. 
DO 25 L = 1,NEQN 
PHI(L,15) = @.0 
IFAIL = @ 
KKK END BLOCK @ aK 


tek BEGIN BLOCK 1 wa 


COMPUTE COEFFICIENTS OF FORMULAS FOR THIS STEP. AVOID COMPUTING 
THOSE QUANTITIES NOT CHANGED WHEN STEP SIZE IS NOT CHANGED. 


10@ KP1 


KKK 


K+1 
K+2 
K-1 
K-2 


Hon 


KP2 
KML 
KM2 


5710 
5726 


5740 
5750 
5760 
5770 
5780 
5790 
5800 
5810 
5820 
5830 
5840 
5850 
5860 
5870 
5880 
5890 
5900 
5910 
5920 
5930 
5940 
5950 
5960 
5970 
5986 
5996 
6000 
6010 
6020 
6030 
6040 
6050 
6060 
6070 
6080 
6096 
6100 
6110 
6120 
6130 
6146 
6150 
6160 
6170 
6180 
6190 
6200 
6210 
6220 
6230 
6240 
6250 
6260 
6270 
6280 
6290 
6300 
6310 
6320 
6330 
6340 
6350 
6360 
6370 
6380 
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COLLECTED ALGORITHMS (cont.) 


C 
C 


QAaAAA 


oOo nado 


Qa 


aan 


oO 


AaAANRNAANANA 


NS IS THE NUMBER OF STEPS TAKEN WITH SIZE H, INCLUDING THE CURRENT 
WHEN K.LT.NS, NO COEFFICIENTS CHANGE 


ONE. 
IF(H .NE. HOLD) NS = @ 
NS = MIN@(NS+1,KOLD+1) 
NSP1 = NS+1 
IF (K .LT. NS) GO TO 199 


COMPUTE THOSE COMPONENTS OF ALPHA(*),BETA(*) ,PSI(*) ,SIG(*) WHICH 


ARE CHANGED 


BETA(NS) = 1.9 
REALNS = NS 
ALPHA(NS) = 1.@/REALNS 
TEMP1 = H*REALNS 
SIG(NSP1) = 1.6 
iF(K .LT. NSPi) GO To ii@ 
DO 105 I = NSP1,K 
IM1 = I-1 
TEMP2 = PSI(IM1) 
PSI(IM1) = TEMP1 


BETA(L) = BETA(IM1)*PSI(IM1) /TEMP2 


TEMP] = TEMP2 + H 
ALPHA(I) = H/TEMP1 
REALI = I 


165 SIG(I+1) = REALI*ALPHA(I)*SIG(I) 


116 PSI(K) = TEMP1 
COMPUTE COEFFICIENTS G(*) 
INITIALIZE V(*) AND SET W(*). 


LF(NS .GT. 1) GO TO 120 
DO 115 Iq = 1,K 
TEMP3 = IQ*(IQ+1) 
V(IQ) = 1.0/TEMP3 
115 W(1Q) = V(1Q) 
GO TO 14¢ 


G(2) IS SET IN DATA STATEMENT 


IF ORDER WAS RAISED, UPDATE DIAGONAL PART OF V(*) 


129 IF(K .LE. KOLD) GO TO 13¢ 
TEMP4 = K*KP1 
V(K) = 1.06/TEMP4 
NSM2 = NS-2 
IF(NSM2 .LT. 1) GO TO 13@ 
DO 125 J = 1,NSM2 
I = K-J 


125 V(I) = VCCI) - ALPHA(J+1)*V(1I+1) 


UPDATE V(*) AND SET W(*) 


13@ LIMIT1 = KP1 - NS 
TEMP5 = ALPHA(NS) 
DO 135 IQ = 1,LIMIT1 


V(IQ) = V(IQ) - TEMP5*V(IQ+1) 


135 W(IQ) = V(IQ) 
G(NSP1) = W(1) 


COMPUTE THE G(*) IN THE WORK VECTOR W(*) 


14@ NSP2 = NS + 2 
IF(KP1 .LT. NSP2) GO TO 199 
DO 15@ I = NSP2,KP1 
LIMIT2 = KP2 - I 
TEMP6 = ALPHA(I-1) 
DO 145 IQ = 1,LIMIT2 


145 W(IQ) = W(IQ) - TEMP6*W(IQ+1) 


15@ =G(T) = W(1) 
199 CONTINUE 


KEK END BLOCK 1 RKK 


KKK BEGIN BLOCK 2 


KKK 


PREDICT A SOLUTION P(*), EVALUATE DERIVATIVES USING PREDICTED 
SOLUTION, ESTIMATE LOCAL ERROR AT ORDER K AND ERRORS AT ORDERS K, 


K-1, K-2 AS IF CONSTANT STEP SIZE WERE USED. 


KKK 


6390 
6406 
6410 
6420 
6430 
6440 
6456 
6460 
6470 
6480 
6490 
6500 
651¢ 
6526 
6530 
6546 
6550 
6560 
65706 
6586 
6596 
6600 
6610 
6620 
6630 
6646 
6650 
6660 
6670 
6680 
6690 
6700 
6710 
6720 
6730 
6740 
675@ 
6760 
6770 
6780 
6790 
6800 
681¢ 
6826 
6830 
6846 
6856 
6860 
6870 
6880 
6890 
6900 
6916 
6920 
6930 
6940 
6950 
6960 
6970 
6986 
6990 
7600 
701 
7020 
7630 
7040 
7050 
7060 
7076 
7680 
7090 
7100 
7116 
7126 
7130 
7140 


555-P15- 


0 


COLLECTED ALGORITHMS (cont.) 


¢ 715@ 
C CHANGE PHI TO PHI STAR 7160 
C 7170 
IF(K .LT. NSP1) GO TO 215 7180 

DO 21@ I = NSP1,K 7190 

TEMP1 = BETA(L) 7200 

DO 205 L = 1,NEQN 7210 

265 PHI(L,I) = TEMP1*PHI(L,I) 7220 
210 CONTINUE 7230 

C 7240 
C PREDICT SOLUTION AND DIFFERENCES 7250 
C 7260 
215 DO 220 L = 1,NEQN 7270 
PHI(L,KP2) = PHI(L,KP1) 7280 
PHI(L,KP1) = 0. 7290 

220 «=P(L) = @.¢ 7300 
DO 23@ J = 1,K 7310 

Tis RPT 7324 

IP1l = I+l 7330 

TEMP2 = G(I) 7346 

DO 225 L = 1,NEQN 7350 

P(L) = P(L) + TEMP2*PHI(L,I) 7360 

225 PHI(L,I) = PHI(L,I) + PHI(L,IP1) 7370 
23@ CONTINUE 7380 
LE(NORND) GO TO 24¢ 7390 

DO 235 L = 1,NEQN 7400 

TAU = H*P(L) ~ PHI(L,15) 7410 

P(L) = Y(L) + TAU 7426 

235 PHI(L,16) = (P(L) - Y(L)) -TAU 7430 
GO TO 256 7446 

240 DO 245 L = 1,NEQN 7450 
245 PCL) = YC(L) + H*P(L) 7460 
250 XOLD = X 7470 
X=X+H 7480 

ABSH = ABS(H) 7490 

CALL F(X,P,YP) 7500 

C 751¢ 
C ESTIMATE ERRORS AT ORDERS K,K-1,K-2 7520 
ERKM2 = @.@ 7530 

ERKM1 = 0.6 7540 

ERK = @.@ 755@ 

DO 265 L = 1,NEQN 7560 

TEMP3 = 1.6/WT(L) 7570 

TEMP4 = YP(L) - PHI(L,1) 7580 

IF(KM2) 265,260,255 7590 

255 ERKM2 = ERKM2 + ((PHI(L,KM1)+TEMP4) *TEMP3)**2 | 7600 
26@  ERKML = ERKMI + ((PHI(L,K)+TEMP4) *TEMP3) *#2 7610 
265 ERK = ERK + (TEMP4*TEMP3) **2 7620 
IF(KM2) 280,275,27¢ 7630 

270 ERKM2 = ABSH*SIG(KM1) *GSTR(KM2) *SQRT (ERKM2) 7640 
275 ERKM1L = ABSH*SIG(K)*GSTR(KM1) *SQRT (ERKM1) 7650 
286 TEMPS = ABSH*SQRT (ERK) 7660 
ERR = TEMP5*(G(K)-G(KP1)) 7679 

ERK = TEMP5*SIG(KP1)*GSTR(K) 7686 

KNEW = K 7690 

Cc 7700 
C TEST IF ORDER. SHOULD BE LOWERED 7710 
Cc 7720 
LF(KM2) 299,29@, 285 7730 

285 IF(AMAX1(ERKM1,ERKM2) .LE. ERK) KNEW = KM1 7740 
GO TO 299 7750 

290 IF(ERKM1 .LE. @.5*ERK) KNEW = KM1 7760 

C 7770 
C TEST IF STEP SUCCESSFUL 7780 
C 779¢ 
299 IF(ERR .LE. EPS) GO TO 46¢ 7800 

C KKK END BLOCK 2 KKK 7810 
C 7826 
C ARK BEGIN BLOCK 3 KK 7830 
C THE STEP IS UNSUCCESSFUL. RESTORE X, PHI(*,*), PSI(*) 7840 
C IF THIRD CONSECUTIVE FAILURE, SET ORDER TO ONE. IF STEP FAILS MORE 7850 
C THAN THREE TIMES, CONSIDER AN OPTIMAL STEP SIZE. DOUBLE ERROR 786@ 
C TOLERANCE AND RETURN IF ESTIMATED STEP SIZE IS TOO SMALL FOR MACHINE787@ 
C PRECISION 7880 
Cc KKK 7890 
Cc 7900 
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C 
C 


Oa aa 


Ononaaanqa 


aaa f.09 09 


2 OY Oa a 


RESTORE X, PHI(*,*) AND PSI(*) 


PHASE1 = .FALSE. 
X = XOLD 
DO 31@ I = 1,K 
TEMP1 = 1.¢/BETA(I) 
IPl = I+1 
DO 365 L = 1,NEQN 
305 PHI(L,I) = TEMP1*(PHI(L,I) - PHI(L,IP1)) 
319 CONTINUE 
IF(K .LT. 2) GO TO 320 


DO 315 I = 2,K 
315 PSI(I-1) = PSI(I) - H 
ON THIRD FAILURE, SET ORDER TO ONE. THEREAFTER, USE OPTIMAL STEP 
SIZE 
32@ IFAIL = IFAIL + 1 
TEMP2 = @.5 


IF(IFAIL - 3) 335,330,325 
325 IF(P5EPS .LT. @.25*ERK) TEMP2 = SQRT(P5EPS/ERK) 
33@ KNEW = 1 
335 H = TEMP2*H 

K = KNEW 

IF(ABS(H) .GE. FOURU*ABS(X)) GO TO 34@ 

CRASH = .TRUE. 

H = SIGN(FOURU*ABS (X) ,H) 

EPS = EPS + EPS 


RETURN 
346 GO TO 100 
RAK END BLOCK 3 RKK 
eK BEGIN BLOCK 4 RKK 
THE STEP IS SUCCESSFUL. CORRECT THE PREDICTED SOLUTION, EVALUATE 
THE DERIVATIVES USING THE CORRECTED SOLUTION AND UPDATE THE 
DIFFERENCES. DETERMINE BEST ORDER AND STEP SIZE FOR NEXT STEP. 
KK 
406 KOLD = K 
HOLD = H 
CORRECT AND EVALUATE 


TEMP1 = H*G(KP1) 
ITF(NORND) CO TO 41¢ 
DO 405 L = 1,NEQN 
RHO = TEMP1*(YP(L) - PHI(L,1)) - PHI(L,16) 
Y(L) = P(L) + RHO 
465 PHI(L,15) = (Y(L) - P(L)) - RHO 
GO TO 420 
410 DO 415 L = 1,NEQN 
415 Y(L) = P(L) + TEMP1*(YP(L) - PHI(L,1)) 
42@ CALL F(X,Y,YP) 


UPDATE DIFFERENCES FOR NEXT STEP 


DO 425 L = 1,NEQN 
PHI(L,KP1) = YP(L) - PHI(L,1) 
425 PHI(L,KP2) = PHI(L,KP1) - PHI(L,KP2) 
DO 435 I = 1,K 
DO 430 L = 1,NEQN 
430 PHI(L,I) = PHI(L,I) + PHI(L,KP1) 
435 CONTINUE 


tow 


ESTIMATE ERROR AT ORDER K+1 UNLESS& 
IN FIRST PHASE WHEN ALWAYS RAISE ORDER, 
ALREADY DECIDED TO LOWER ORDER, 
STEP SIZE NOT CONSTANT SO ESTIMATE UNRELIABLE 


ERKP1 = 6.@ 
IF(KNEW .EQ. KML .OR. K .EQ. 12) PHASE] = .FALSE. 
IF(PHASE1) GO TO 45@ 
IF(KNEW .EQ. KM1) GO TO 455 
LF(KP1 .GT. NS) GO TO 460 
DO 449 L = 1,NEQN 
440  ERKP1 = ERKP1 + (PHI(L,KP2)/WT(L))**2 
ERKP1 = ABSH*GSTR(KP1)*SQRT (ERKP1) 


7910 
7920 
7930 
7940 
7950 
7960 
7970 
7980 
7990 
8000 
8010 
8020 
8030 
840 
8050 
8060 
80670 
8080 
8690 
8160 
8110 
8120 
8130 
8140 
8150 
8166 
8170 
8180 
8190 
8200 
8210 
8220 
8230 
8246 
8256 
8260 
8276 
8280 
8290 
8300 
8316 
8320 
8330 
8340 
835¢ 
8360 
8370 
8380 
8390 
8400 
8416 
8420 
8430 
8440 
8450 
8460 
8470 
8480 
8496 
8500 
8510 
8520 
8530 
8546 
8550 
8560 
8570 
8580 
8590 
8660 
8616 
8626 
8630 
8640 
8650 
8660 
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OA 


OO Oe) 


a 


C42 GO OF Oe a 


ANAAAANAAANAANAA 


USING ESTIMATED ERROR AT ORDER Kt+1, DETERMINE APPROPRIATE ORDER 
FOR NEXT STEP 


445 


LF(K .GT. 1) GO TO 445 

IF(ERKP1 .GE. @.5*ERK) GO TO 46¢ 

GO TO 45¢ 

IF(ERKM1 .LE. AMIN1(ERK,ERKP1)) GO TO 455 
IF(ERKP1 .GE. ERK .OR. K .EQ. 12) GO TO 460 


HERE ERKP1 .LT. ERK .LT. AMAX1(ERKM1,ERKM2) ELSE ORDER WOULD HAVE 
BEEN LOWERED IN BLOCK 2. THUS ORDER IS TO BE RAISED 


RAISE ORDER 


450 


K = KP1 
ERK = ERKP1 
GO TO 460@ 


LOWER ORDER 


455 


K = KM1 
ERK = ERKM1L 


WITH NEW ORDER DETERMINE APPROPRIATE STEP SIZE FOR NEXT STEP 


460 


465 


HNEW = H+ 4H 
IF(PHASE1) GO TO 465 
IF(P5EPS .GE. ERK*TWO(K+1)) GO TO 465 
HNEW = H 
IF(P5EPS .GE. ERK) GO TO 465 
TEMP2 = K+1 
R = (P5EPS/ERK)**(1.0/TEMP2) 
HNEW = ABSH*AMAX1(0.5,AMIN1(@.9,R)) 
HNEW = SIGN(AMAX1 (HNEW, FOURU*ABS (X)) ,H) 
H = HNEW 
RETURN 

aK END BLOCK 4 KK 
END 


SUBROUTINE INTRP(X,Y,XOUT,YOUT,YPOUT, NEQN,KOLD, PHI,PSI) 


THE METHODS IN SUBROUTINE STEP APPROXIMATE THE SOLUTION NEAR X 
BY A POLYNOMIAL. SUBROUTINE INTRP APPROXIMATES THE SOLUTION AT 


XOUT BY EVALUATING THE POLYNOMIAL THERE. 


POLYNOMIAL IS PASSED FROM STEP SO INTRP CANNOT BE USED ALONE. 


THIS CODE IS COMPLETELY EXPLAINED AND DOCUMENTED IN THE TEXT, 


COMPUTER SOLUTION OF ORDINARY DIFFERENTIAL EQUATIONS& THE INITIAL 


VALUE PROBLEM BY L. F. SHAMPINE AND M. K. GORDON. 


INPUT TO INTRP -- 


THE USER PROVIDES STORAGE IN THE CALLING PROGRAM FOR THE ARRAYS IN 


THE CALL LIST 


DIMENSION Y(NEQN) , YOUT(NEQN) , YPOUT (NEQN) , PHI (NEQN,16) ,PSI (12) 


AND DEFINES 


XOUT -- POINT AT WHICH SOLUTION IS DESIRED. 


THE REMAINING PARAMETERS ARE DEFINED IN STEP AND PASSED TO INTRP 
FROM THAT SUBROUTINE 


OUTPUT FROM INTRP -- 


YOUT(*) -~ SOLUTION AT XOUT 
YPOUT(*) -- DERIVATIVE OF SOLUTION AT XOUT 


THE REMAINING PARAMETERS ARE RETURNED UNALTERED FROM THEIR INPUT 
VALUES. INTEGRATION WITH STEP MAY BE CONTINUED. 


DIMENSION G(13),W(13),RHO(13) 
DATA G(1)/1.0/,RHO(1)/1.6/ 


HI = XOUT - X 
KI = KOLD + 1 
KIP1 = KI + 1 


INFORMATION DEFINING THIS 


8670 
8680 
8696 
8700 
8710 
8720 
8730 
8740 
8750 
8760 
8770 
8780 
8790 
8800 
881¢ 
8820 
8836 
8846 
8850 
8860 
8870 
8880 
8890 
8900 
8910 
8926 
8930 
8940 
8950 
8960 
8970 
8980 
8999 
9000 
9010 
9620 
9030 
9640 
9050 


9960 
9070 
9080 
9690 
9190 
9110 
912 
9136 
914¢ 
915@ 
9160 
9170 
9180 
9190 
9260 
9216 
9220 
9230 
9240 
9250 
9260 
9270 
9286 
9296 
9300 
9316 
9320 
9330 
9340 
9350 
9360 
9370 
9380 
9390 
9400 
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SAO AODHOMA OOOA Aaa OA AO OoOAe Aaa nase ona aA A 


Cc 
C 


C 
Cc 


qaqa 


INITIALIZE W(*) FOR COMPUTING G(*) 
dO 5 I = 1,KI 
TEMP1 = I 
5 W(1) = 1.0/TEMP1 
TERM = @.¢ 
COMPUTE G(*) 
po 15 J = 2,KI 
JMl1=J-1 


PSIJM1 = PSI(JM1) 
GAMMA = (HI + TERM)/PSIJM1 
ETA = HI/PSIJM1 
LIMIT1 = KIP1 - J 
DO 10 I = 1,LIMIT1 
10 W(L) = GAMMA*W(I) - ETA*W(I+1) 
G(J) = W(1) 
RHO(J) = GAMMA*RHO(JM1) 
15 TERM = PSIJM1 


INTERPOLATE 


DO 20 L = 1,NEQN 
YPOUT(L) = 9.0 

20 YOUT(L) = 6.6 
DO 3@ J = 1,KI 


TEMP2 = G(1) 
TEMP3 = RHO(I) 
DO 25 L = 1,NEQN 
YOUT(L) = YOUT(L) + TEMP2*PHI (L,I) 
25 YPOUT(L) = YPOUT(L) + TEMP3*PHI (L,I) 
30 CONTINUE 
DO 35 L = 1,NEQN 
35 YOUT(L) = Y(L) + HI*YOUT(L) 
RETURN 
END 


SUBROUTINE ROOT(T,FT,B,C,RELERR,ABSERR, IFLAG) 


ROOT COMPUTES A ROOT OF THE NONLINEAR EQUATION F(X)=@ 
WHERE F(X) IS A CONTINOUS REAL FUNCTION OF A SINGLE REAL 
VARIABLE X. THE METHOD USED IS A COMBINATION OF BISECTION 
AND THE SECANT RULE. 


NORMAL INPUT CONSISTS OF A CONTINUOS FUNCTION F AND AN 
INTERVAL (B,C) SUCH THAT F(B)*F(C).LE.@.@. EACH ITERATION 
FINDS NEW VALUES OF B AND C SUCH THAT THE INTERVAL(B,C) IS 
SHRUNK AND F(B)*F(C).LE.@.@. THE STOPPING CRITERION IS 


ABS (B-C) . LE. 2.@* (RELERR*ABS (B)+ABSERR) 
WHERE RELERR=RELATIVE ERROR AND ABSERR=ABSOLUTE ERROR ARE 
INPUT QUANTITIES. 
THE COMPUTATION. 
OUTPUT, THEY MUST BE VARIABLES IN THE CALLING PROGRAM. 
IF @ IS A POSSIBLE ROOT, ONE SHOULD NOT CHOOSE ABSERR=0.@. 


THE OUTPUT VALUE OF B IS THE BETTER APPROXIMATION TO A ROOT 


AS B AND C ARE ALWAYS REDEFINED SO THAT ABS(F(B)).LE.ABS(F(C)). 


TO SOLVE THE EQUATION, ROOT MUST EVALUATE F(X) REPEATEDLY. THIS 


IS DONE IN THE CALLING PROGRAM. WHEN AN EVALUATION OF F IS 
NEEDED AT T, ROOT RETURNS WITH IFLAG NEGATIVE. 
AND CALL ROOT AGAIN. DO NOT ALTER IFLAG. 


WHEN THE COMPUTATION IS COMPLETE, ROOT RETURNS TO THE CALLING 


PROGRAM WITH IFLAG POSITIVE= 


IFLAG=1 IF F(B)*F(C).LT.@ AND THE STOPPING CRITERION IS MET. 


=2 IF A VALUE B IS FOUND SUCH THAT THE COMPUTED VALUE 
THE INTERVAL (B,C) MAY NOT 


F(B) IS EXACTLY ZERO. 


SET THE FLAG, IFLAG, POSITIVE TO INITIALIZE 
AS B,C AND IFLAG ARE USED FOR BOTH INPUT AND 


EVALUATE FT=F(T) 


9410 
9420 
9430 
9440 
9450 
9460 
9470 
9480 
9490 
9500 
9519 
9520 
9530 
9540 
9550 
9560 
9570 
9580 
9590 
9600 
9610 
9620 
9630 
9640 
9650 
9660 
9670 
9680 
9690 
9700 
9710 
9720 
9730 
9740 
9750 
9760 
9770 
9780 


9790 
9800 
9810 
9820 
9830 
9840 
9850 
9860 
9870 
9880 
93890 
9990 
9910 
9926 
9930 
9940 
9950 
9960 
9976 
9980 
9990 
16000 
10614 
16020 
160630 
10046 
10050 
10660 
16076 
16086 
100906 
1010606 
10110 
1912 
10130 
16140 
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COLLECTED ALGORITHMS (cont.) 
C SATISFY THE STOPPING CRITERION. 190150 
C 1016¢ 
C =3 IF ABS(F(B)) EXCEEDS THE INPUT VALUES ABS(F(B)), 10176 
C ABS(F(C)). IN THIS CASE IT IS LIKELY THAT B IS CLOSE 19180 
Cc TO A POLE OF F. 19190 
Cc 10200 
c =4 IF NO ODD ORDER ROOT WAS FOUND IN THE INTERVAL. A 10210 
Cc LOCAL MINIMUM MAY HAVE BEEN OBTAINED. 190220 
C 16230 
Cc =5 IF TOO MANY FUNCTION EVALUATIONS WERE MADE. 10240 
C (AS PROGRAMMED, 5@@ ARE ALLOWED.) 10250 
Cc 19260 
C THIS CODE IS A MODIFICATION OF THE CODE ZEROIN WHICH IS COMPLETELY 16270 
C EXPLAINED AND DOCUMENTED IN THE TEXT, NUMERICAL COMPUTING= AN 10280 
C INTRODUCTION BY L. F. SHAMPINE AND R. C. ALLEN. 19290 
c 16300 
CHRKAERKKRKEREIK RR ERERRK EKER RE RRER RR EK ER RERERERREREREERREREREEREERREREREREEE GILG 
C* THE ONLY MACHINE DEPENDENT CONSTANT IS BASED CN THE MACHINE UNIT *10320 
C* ROUNDOFF ERROR U WHICH IS THE SMALLEST POSITIVE NUMBER SUCH THAT *1033¢ 
Cx 1.@+U .GT. 1.6. U MUST BE CALCULATED AND INSERTED IN THE *16340 
C* FOLLOWING DATA STATEMENT BEFORE USING ROOT. THE ROUTINE MACHIN *10350 
C* CALCULATES U. 10360 
c* FOR THE CDC 65060, 66060, 7600 -- * 
c* DATA U /1641490660066000600000B/ 
C* FOR THE IBM 360/370 (SINGLE PRECISION) —- * 
cx DATA U /Z3C100000/ 
C* FOR THE IBM 360/376 (DOUBLE PRECISION) -- * 
cx DATA U /Z3410600066600000/ 
C* FOR THE UNIVAC 1168 AND HONEYWELL 6@@@ -- x 
cx DATA U /2.@**(—26)/ 
Cx FOR THE PDP-11 -- * 
c* DATA U /2.0**(-23)/ 


CRERKAKARARKRERK RE RUERE RE RRR ER ERR RR RRRRERREREREREREREREREREREREREREREE | QI 8G 


C 


C 


IF(LFLAG.GE.@) GO TO 160 


IFLAG=IABS (1FLAG) 
GO TO (200, 366,400), 
106 RE=AMAX1 (RELERR, U) 
AE=AMAX]1 (ABSERR, 0.) 
Ic=¢ 
ACBS=ABS (B-C) 
A=C 
TSA 
IFLAG=-1 
RETURN 
200 FA=FT 
T=B 
IFLAG=-2 
RETURN 
300 FB=FT 
FC=FA 
KOUNT=2 


IFLAG 


FX=AMAX1 (ABS (FB) , ABS (FC) ) 
1 IF(ABS(FC).GE.ABS(FB))GO TO 2 


C INTERCHANGE B AND C SO YHAT ABS(F(B)).LE.ABS(F(C)). 


C 


Aaa 


a Se ns ee ce 


A=B 
FA=FB 
B=C 
FB=FC 
C=A 
FC=FA 
2 CMB=@.5* (C-B) 
ACMB=ABS (CMB) 
TOL=RE*ABS (B)+AE 


TEST STOPPING CRITERION AND FUNCTION COUNT. 


IF(ACMB.LE.TOL)GO TO 8 
LF (KOUNT.GE.5@@)GO TO 12 


CALCULATE NEW ITERATE EXPLICITLY AS B+P/Q 


WHERE WE ARRANGE P.GE.@. 


THE IMPLICIT 


FORM IS USED TO PREVENT OVERFLOW. 


19396 
104060 
19419 
10420 
10436 
16446 
1045 
10460 
10476 
16486 
16490 
10500 
16510 
10520 
106530 
16546 
1055¢@ 
16566 
16570 
10580 
10590 
106060 
1961@ 
19620 
10630 
1064 
10650 
19660 
19670 
10680 
1969¢@ 
10760 
10710 
10726 
10730 
1074 
10750 
10760 
10770 
10780 
10796 
108060 
16810 
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COLLECTED ALGORITHMS (cont.) 


Oana 


aa 


aa 


C 


P=(B-A) *FB 

Q=FA-FB 
IF(P.GE.@.6)GO TO 3 
P=-P 

Q=-Q 


UPDATE A, CHECK IF REDUCTION IN THE SIZE OF BRACKETING 
INTERVAL IS SATISFACTORY. IF NOT BISECT UNTIL IT IS. 


3 A=B 
FA=FB 
IC=IC+1 
IF(IC.LT.4)GO TO 4 
IF(8.0*ACMB.GE.ACBS)GO TO 6 
Ic=@ 
ACBS=ACMB 

TEST FOR TOO SMALL A CHANGE. 

4 IF(P.GT.ABS(Q)*TOL)GO TO 5 
INCREMENT BY TOLERANCE 


B=B+S IGN (TOL, CMB) 
GO TO 7 


ROOT OUGHT TO BE BETWEEN B AND (C+B)/2 
5 IF(P.GE.CMB*Q)GO TO 6 
USE SECANT RULE. 


B=B+P/Q 
GO TO 7 


USE BISECTION. 


6 B=@.5*(C+B) 


HAVE COMPLETED COMPUTATION FOR NEW ITERATE B. 


7 T=B 
IFLAG=-3 
RETURN 
400 FB=FT 
IF(FB.EQ.¢.9)GO TO 9 
KOUNT=KOUNT+1 
IF(SIGN(1.@,FB) .NE.SIGN(1.@,FC))GO TO 1 
C=A 
FC=FA 
GO TO 1 


C FINISHED. SET IFLAG. 


C 


8 LF(SIGN(1.0, FB) .EQ.SIGN(1.6,FC))GO TO 11 
LF (ABS (FB) .GT.FX)GO TO 1¢ 
LFLAG=1 
RETURN 

9 IFLAG=2 
RETURN 

1@ LFLAG=3 
RETURN 

11 IFLAG=4 
RETURN 

12 IFLAG=5 
RETURN 
END 


16820 
19830 
1084¢ 
10850 
10860 
16870 
1088¢ 
10890 
1690¢ 
1991¢ 
10920 
10930 
19940 
19950 
16960 
19976 
10980 
19996 
11000 
110616 
11062¢ 
11030 
11040 
110650 
110606 
11676 
11080 
119696 
11106 
111146 
11120 
11130 
11140 
1115@ 
11160 
11170 
1118¢@ 
1119¢ 
112066 
11214 
11226 
11230 
11240 
11250 
11260 
112706 
11280 
11296 
11300 
1131 
11320 
11330 
11340 
11356 
11360 
1137@¢ 
11386 
1139 
114060 
11410 
11426 
11436 
11440 
11456 
11460 
11476 
11486 


555-P21- 


0 


COLLECTED ALGORITHMS FROM ACM 


556-P 1- 0 


ALGORITHM 556 
Exponential Integrals [S13] 


DONALD E. AMOS 
Sandia National Laboratories 


Key Words and Phrases: exponential integrals, Miller algorithm, confluent hypergeometric 
functions 

CR Categories: 5.12 

Language: Fortran 


DESCRIPTION 


The Fortran subroutine EXPINT given here is an implementation of [1]. EX- 
PINT has four machine-dependent parameters XCUT, XLIM, ETOL, and EU- 
LER which are set into DATA statements. XCUT is a breakpoint such that for 
x <= XCUT, the series is evaluated and for x > XCUT, the Miller algorithm is 
applied. XLIM is the approximate underflow limit for e-*, x = 0, and ETOL is 
nominally set to 1.E—D where D is the number of base 10 digits in a word. 
EULER is the negative Euler constant, —y. Thus 


DATA XCUT, XLIM, ETOL/2.0, 667.0, 1.E-12/ 
would be appropriate for CDC single-precision arithmetic, while 
DATA XCUT, XLIM, ETOL/1.0, 172.0, 1.E—6/ 


would be appropriate for IBM single-precision arithmetic. The two choices for 
XCUT reflect the fact that there is a loss of up to two digits on 1 < x = 2 with the 
series evaluation. This loss can be tolerated on longer word length machines, but 
not on shorter word length machines. 

Maximum accuracy can always be achieved with XCUT = 1. However, for 
longer word lengths where D = 14, the reduction in computation by moving 
XCUT from 1 to 2, achieved at the expense of two digits of accuracy, seems to be 
a worthwhile trade-off, and D = 12 reflects this modification for CDC machines. 
D = 12 is also more consistent with the accuracy attainable from EXP(—X) near 
the underflow limit X = 667. 

While the subroutine EXPINT is almost portable, the function DIGAM, which 
computes the psi function at integer arguments, is supplied as a CDC 6600-7600 
Fortran function. Modifications for other machines can be made easily from eq. 
(7) of [1]. 

The convergence of eq. (2) in [1] is so rapid that the m = n — 1 term, which 
requires y(n), is reached for only small values of n. A table of 100 values suffices 
for virtually all single-precision implementations of EXPINT. An initialization 
step to generate a higher precision table might be appropriate if multiple precision 
is anticipated. For CDC single precision or IBM double precision, 36 values 
suffice for n as high as 10” and relative errors of 107 '* 
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Testing of EXPINT 
Extensive testing of EXPINT against a quadrature 


eat) 
E,(x) = e*x"" i i 


x 


was used to check out the routine on parameter ranges 


at e —(t—2:) 


E,(x) = ex"! | 


x 
was used to check out the routine on parameter ranges 


10°" <= TOLS0.1 
0< X = 100 
1=N<=100 
1=M<= 100 
XCUT = 1, 2 
KODE = 1, 2 


where KODE is used to scale En+z(x), k =0,1,..., M— 1 by e’, if desired. Some 
spot checks for x and N in the hundreds, as well as special values XCUT + 107", 
were also made at tolerances TOL as low as 10°°. The quadrature could be relied 
upon to give the requested accuracy down to TOL = 10~"' over the full exponent 
range of the CDC 6600. For large x, argument reduction in computing e~* will 
result in decreased accuracy, up to three digits near the underflow limit x ~ 667. 
Hence tolerances smaller than 10°" would require double-precision exponentials 
to obtain checks for large x. 

Relative errors in long sequences, up to 100 terms, were checked for degradation 
of the recurrence by comparing members of a sequence with single evaluations 
(M = 1) at high accuracies. When M = 1, EXPINT uses one of the two basic 
methods for evaluation rather than recursion. 

Relative errors in all of these tests were less than the relative error specified in 
EXPINT to generate the test values. 


REFERENCE 
1. Amos, D.E. Computation of exponential integrals. ACM Trans. Math. Softw. 6, 3 (Sept. 1980), 
365-377. 

ALGORITHM 

SUBROUTINE EXPINT(X, N, KODE, M, TOL, EN, IERR) EXP 1¢ 
Cc EXP 20 
Cc WRITTEN BY D.E. AMOS, SANDIA LABORATORIES, ALBUQUERQUE, NM, 87185 EXP 36 
Cc EXP 40 
6 REFERENCE EXP 54 
C COMPUTATION OF EXPONENTIAL INTEGRALS BY D.E. AMOS, ACM EXP 60 
C TRANS. MATH SOFTWARE, 1980 EXP 70 
C EXP 80 
C ABSTRACT EXP 90 
C EXPINT COMPUTES M MEMBER SEQUENCES OF EXPONENTIAL INTEGRALS EXP 16@ 
C E(N+K,X), K=@,1,...,M-1 FOR N.GE.1 AND X,.GE.@. THE POWER EXP 11¢ 
C SERLES IS IMPLEMENTED FOR X.LE.XCUT AND THE CONFLUENT EXP 12@ 
Cc HYPERGEOMETRIC REPRESENTATION EXP 130 
C EXP 146 
C E(A,X) = EXP (—X) * (X**(A-1) )*U(A,A, X) EXP 15@ 
C EXP 166 
Cc IS COMPUTED FOR X.GIT.XCUT. SINCE SEQUENCES ARE COMPUTED IN A EXP 170 
C STABLE FASHION BY RECURRING AWAY FROM X, A IS SELECTED AS THE EXP 18¢ 
C INTEGER CLOSEST TO X WITHIN THE CONSTRAINT N.LE.A.LE.N+M-1. EXP 190 
Cc FOR THE U COMPUTATION A IS FURTHER MODIFIED TO BE THE EXP 20 
C NEAREST EVEN INTEGER. INDICES ARE CARRIED FORWARD OR EXP 210 
C BACKWARD BY THE TWO TERM RECURSION RELATION EXP 226 
C EXP 230 
C K*E(K+1,X) + X*E(K,X) = EXP(--X) EXP 240 


COLLECTED ALGORITHMS (cont.) 


Aaaannnnaanananananaanananananaananananaannagaanaagaaagaaaagaana 


a 


=) 


ONCE E(A,X) IS COMPUTED. THE U FUNCTION IS COMPUTED BY MEANS 


OF THE BACKWARD RECURSIVE MILLER ALGORITHM APPLIED TO THE 
THREE TERM CONTIGUOUS RELATION FOR U(A+K,A,X), K=@,1,... 


THIS PRODUCES ACCURATE RATIOS AND DETERMINES U(A+K,A,X),AND 


HENCE E(A,X), TO WITHIN A MULTIPLICATIVE CONSTANT C. 
ANOTHER CONTIGUOUS RELATION APPLIED TO C*U(A,A,X) AND 


C*XU(At+1, A,X) GETS C*U(At1, A+1,X), A QUANTITY PROPORTIONAL TO 


E(At1, X). THE NORMALIZING CONSTANT C IS OBTAINED FROM THE 
TWO TERM RECURSION RELATION ABOVE WITH K=A. 


MACHINE DEPENDENT PARAMETERS ~ XCUT, XLIM, ETOL, EULER, DIGAM 


EXPINT WRITES ERROR DIAGNOSTICS TO LOGICAL UNIT 3 


DESCRIPTION OF ARGUMENTS 


INPUT 


KODE 


TOL 


OUTPUT 
EN 


IERR 


X.GT.@.@ FOR N=l1 AND X.GE.@.@ FOR N.GE.2 


ORDER OF THE FIRST MEMBER OF THE SEQUENCE, N.GE.1 


A SELECTION PARAMETER FOR SCALED VALUES 

KODE=1 RETURNS E(N+K,X), K=@,1,...,M-1. 
=2 RETURNS EXP(X)*E(N+K,X), K=@,1,...,M-1. 

NUMBER OF EXPONENTIAL INTEGRALS IN THE SEQUENCE, 

M.GE.1 

RELATIVE ACCURACY WANTED, ETOL.LE.TOL.LE.@.1 

ETOL=1.E-12 


A VECTOR OF DIMENSION AT LEAST M CONTAINING VALUES 


EN(K) = E(N+K-1,X) OR EXP(X)*E(N+K-1,X), K=1,M 
DEPENDING ON KODE 

UNDERFLOW INDICATOR 

IERR=$ A NORMAL RETURN 


=1 X EXCEEDS XLIM AND AN UNDERFLOW OCCURS. 


EN(K)=@.0 , K=1,M RETURNED ON KODE=1 
XLIM=667. 


ERROR CONDITIONS 
AN IMPROPER INPUT PARAMETER IS A FATAL ERROR 


UNDERFLOW IS A NON FATAL ERROR. ZERO ANSWERS ARE RETURNED. 


DIMENSION EN(1), A(99), B(99), Y¥(2) 


DATA XCUT, XLIM, ETOL /2.0E@,667.@GEQ, 1.@E-12/ 
DATA EULER /-5.772156649@1533E-@1/ 


DATA LUN /3/ 


IF 
IF 
IF 
IF 


(N.LT.1) 


GO TO 26@ 


(KODE.LT.1 .OR. KODE.GT.2) GO TO 27@ 
(M.LT.1) GO TO 28@ 
(TOL.LT.ETOL .OR. TOL.GT.@.1E6) GO TO 29¢ 


IERR = @ 
IF (X.GT.XCUT) GO TO 1¢¢ 

IF (X.LT.@.Q@E@) GO TO 3¢¢ 

IF (X.EQ.0.QE@ .AND. N.EQ.1) GO TO 316 
IF (X.EQ.@.Q@E@ .AND. N.GT.1) GO TO 80 


SERIES FOR E(N,X) FOR X.LE.XCUT 


IX 


INT (X+9. 5EQ) 

ICASE=1 MEANS INTEGER CLOSEST TO X IS 2 AND N=1 

ICASE=2 MEANS INTEGER CLOSEST TO X IS @,1, OR 2 AND N.GE.2 
ICASE = 2 
IF (IX.GT.N) ICASE = 1 


NM = N - ICASE + 1 
ND = NM + 1 

IND = 3 - ICASE 

MU = M - IND 

ML = 1 

KS = ND 

FNM = FLOAT (NM) 

S = 0. GEO 

XTOL = 3.QEQ*TOL 


IF (ND.EQ.1) GO TO 1 
= Q.3333EO*TOL 


XTOL 


EXP 259 
EXP 26 
EXP 270 
EXP 28@ 
EXP 290 
EXP 360 
EXP 310 
EXP 320 
EXP 33¢ 
EXP 34 
EXP 359 
EXP 360 
EXP 370 
EXP 38¢ 
EXP 39@ 
EXP 4@¢ 
EXP 41@ 
EXP 426 
EXP 43 
EXP 44@ 
EXP 45 
EXP 46@ 
EXP 47@ 
EXP 48¢ 
EXP 49 
EXP 5@¢@ 
EXP 510 
EXP 520 
EXP 53@ 
EXP 54@ 
EXP 550 
EXP 56@ 
EXP 570 
EXP 586 
EXP 590 
EXP 600 
EXP 610 
EXP 620 
EXP 639 
EXP 646 
EXP 65@ 
EXP 669 
EXP 67@ 
EXP 680 
EXP 690 
EXP 790 
EXP 71 
EXP 72@ 
EXP 734 
EXP 74 
EXP 75@ 
EXP 760 
EXP 77 
EXP 78@ 
EXP 79¢@ 
EXP 86 
EXP 819 
EXP 829 
EXP 83@ 
EXP 84 
EXP 85@ 
EXP 86@ 
EXP 87@ 
EXP 88@ 
EXP 890 
EXP 94 
EXP 910 
EXP 920 
EXP 930 
EXP 946 
EXP 95@ 
EXP 96¢@ 
EXP 976 
EXP 986 
EXP 99@ 
EXP 160% 


EXP 1610 
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COLLECTED ALGORITHMS (cont.) 


CFO.) Cec? & 


19 


20 


7¢ 


80 


99 


160 


11¢ 


12@ 
130 


14¢ 


15¢ 


16@ 


S = 1.QEO/FNM 


CONTINUE 
AA = 1.@E@ 
AK = 1.@E@ 


po 5% I=1, 35 
AA = —AA*X/AK 
LF (I.EQ.NM) GO TO 3@ 
S = S — AA/(AK-FNM) 
LF (ABS(AA).LE.XTOL*ABS(S)) GO TO 20 
AK = AK + 1.0E@ 


GO TO 5¢ 
CONTINUE 
IF (I.LT.2) GO TO 4@ 
IF (ND-2.GT.I .OR. I.GT.ND-1) GO TO 6@ 
AK = AK + L.GE@ 
GO TO 5@ 
S = S + AA*(-ALOG(X)+DIGAM(ND) ) 
XTOL = 3. Q@EQ@*TOL 
AK = AK + 1.0E0 
CONTINUE 
GUO TO 32¢ 
IF (ND.EQ.1) S = S + (-ALOG(X)+EULER) 
IF (KODE.EQ.2) S = S*EXP(X) 
EN(1) = S 
EMX = 1.@E@ 
IF (M.EQ.1) GO TO 70 
EN(IND) = S 


AA = FLOAT(KS) 
IF (KODE.EQ.1) EMX = EXP(-X) 
GO TO (220, 240), ICASE 
IF (ICASE.EQ.2) RETURN 
IF (KODE.EQ.1) EMX = EXP(-X) 
EN(1) = (EMX-S)/X 
RETURN 
CONTINUE 
pO 9¢ I=1,M 
EN(L) = 1. @E@/FLOAT(N+I-2) 
CONTINUE 
RETURN 


BACKWARD RECURSIVE MILLER ALGORITHM FOR 
E(N,X)=EXP (-X) * (X** (N-1)) *U (N,N,X) 

WITH RECURSION AWAY FROM N=INTEGER CLOSEST TO X. 

U(A,B,X) IS THE SECOND CONFLUENT HYPERGEOMETRIC FUNCTION 


CONT INUE 
EMX = 1.@E@ 
IF (KODE.EQ.2) GO TO 13¢ 
IF (X.LE.XLIM) GO TO 12¢ 
TERR = 1 
DO 119 I=1,M 
EN(I) = @. QEO 
CONTINUE 
RETURN 
EMX = EXP (~X) 
CONTINUE 
IX = INT (X+@.5EQ) 
KN=N+M-1 
IF (KN.LE.IX) GO TO 14@ 
IF (N.LT.IX .AND. IX.LT.KN) GO TO 170 
IF (N.GE.IX) GO TO 16@ 
GO TO 34¢ 
ICASE = 1 


1 
IND = M 
IF (KN.GT.1) GO TO 1890 
KS = 2 
ICASE = 3 
GO TO 18 
ICASE = 2 
IND = 1 
KS = N 
MU =M- 1 
IF (N.GT.1) GO TO 18 


EXP 
EXP 
EXP 


EXP 
EXP 
EXP 
EXP 
EXP 
EXP 


1929 
193 
1040 
165 
1960 
1670 
1986 
1690 
1100 
11106 
112@ 
1130 
1146 
115¢ 
1160 
LL7@ 
1180 
119@ 
L260 
121¢ 
122¢ 
123¢@ 
1240 
1250 
1260 
1270 
128@ 
1290 
1300 
1316 
1320 
1336 
134@ 
1350 
136¢@ 
1370 
138¢ 
1390 
14066 
1410 
1426 
143@ 
1440 
1456 
1460 
1476 
1480 
1490 
1500 
1510 
1520 
1530 
1540 
1556 
1560 
1570 
1580 
159@ 
1600 
161¢ 
1620 
163¢ 
1640 
1650 
1666 
167@ 
168¢ 
1690 
1706 
1716 
1720 
1730 
1740 
1750 
1760 
1770 
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aQAaAaAa 


OQ 


a Ps SA a 


i?) 


176 


180 


196 


200 


IF (KN.EQ.1) GO TO 15¢ 
IX = 2 

ICASE = 1 

KS = IX 

ML = IX - N 

IND = ML + 1 

MU = KN - IX 

CONT INUE 

IK = KS/2 

AH = FLOAT (IK) 

JSET = 1 + KS - (IK+IK) 
START COMPUTATION TOR 


EN(IND) = C*UC A, A ,X) 
ENCIND) = C*U(A+1, At1, X) 


FOR AN EVEN INTEGER A. 
Ic = @ 

AA = AH + AH 

AAMS = AA - 1.GE@ 
AAMS* AAMS 


XTOL = TOL 
IF (TOL.LE.1.@E-3) XTOL 
CT = AAMS + FX*AH 


EM = (AH+1.@EQ) / ((X+AA) *XTOL*SQRT (CT) ) 


FORWARD RECURSION FOR P(IC),P(IC+1) AND INDEX IC FOR BACKWARD 


BK = AA 

cc = AH*AH 

RECURS LON 

Pl = 0.0E@ 

P2 = 1.@E@ 

CONTINUE 

IF (IC.EQ.99) GO TO 336 
Ic = Ic + 1 

AK = AK + 1.@E@ 

AT = BK/(BK+AK+CC+FLOAT (IC) ) 
BK = BK + AK + AK 

A(IC) = AT 

BT = (AK+AK+X) / (AK+1.@GEQ) 
B(IC) = BT 

PT = P2 


P2 = BI*P2 - AT*P1L 
Pl = PT 
CT = CT + FX 


EM = EM*AT* (1. @EG-TX/CT) 
IF (EM*(AK+1.@E@6).GT.P1*P1) GO TO 196 


IcT = Ic 
KK = IC + 1 
BT = TX/(CTI+FX) 


K 
ye) 
wood 


1.@E¢ 


BACKWARD RECURRENCE FOR 


Y1= 


DO 2@@ K=1, ICT 


KK = KK ~- 1] 
YT = Yl 
Yl = (B(KK)*Y1-Y2) /A(KK) 
Yy2 = YT 
CONTINUE 


THE CONTIGUOUS RELATION 


X*U (B, C+1, X)= (C-B) *U(B, C, X)+U(B-1,C,X) 
WLTH B=Atl , C=A LS USED FOR 
Y¥(2) = C * U(AtI,A+1,X) 
X LS INCORPORATED INTO THE NORMALIZING RELATION FOR CNORM. 


Y(1) = YI 


Y¥(2) = YL - Y2*(AH+1. G2) /AA 
CNORM = EMX/ (AA*Y(2)+X*Y (1)) 
IF (ICASE.“Q.3) GO TO 2160 


ENCLIND) = CNORM*Y(JSET) 
IF (M.EQ.1) RETURN 

AA = FLOAT(KS) 

GO TO (220, 240), LCASE 


RECURSION SECTION N®E(N+1,X) + X*E(N,X)=EMX 


20. GEO*TOL 


(BK/ (BK+CC+FLOAT (KK) ) )* (P1/P2)* (1. GEO-BT+@. 375EQ*BT*BT) 


C*UC A ,A,X) 
Y2= C*(A/ (14+A/2))*U(At1, A,X) 


EXP 
EXP 
EXP 
EXP 
XP 
EXP 
NXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
XP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
[EXP 
EXP 
[EXP 
EXP 
EXP 
EXP 
EXP 


178@ 
179@ 
1800 
1810 
182 
1830 
1840 
185@ 
1860 
1879 
1880 
1899 
1900 
1916 
1926 
193@ 
1946 
195 
1966 
1970 
198¢@ 
199¢ 
2000 
2010 
2026 
2030 
2040 
2050 
2060 
20706 
2086 
209¢ 
2160 
211¢ 
2120 
2130 
2140 
2150 
2160 
2170 
218 
2190 
2200 
2210 
2220 
2230 
2240 
2259 
226 
2270 
2280 
2290 
2300 
231 
2320 
2339 
2340 
2350 
2360 
2370 
2380 
2390 
2400 
2419 
2420 
2430 
244 
245 
2460 
2470 
2480 
2490 
2560 
2519 
2520 
2530 
2544 
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COLLECTED ALGORITHMS (cont.) 


210 EN(1) 
RETURN 


226 K = IND - 1 


(EMX-CNORM*Y (1) ) /X 


DO 23@ I=1,ML 
AA = AA - 1.@QE@ 
EN (K) = (EMX-AA*EN (K+1))/X 


K = 


K- 1 


23@ CONTINUE 
IF (MU.LE.@) RETURN 
AA = FLOAT(KS) 


249 K = IND 


DO 25@ I=1,MU 
(EMX-X*EN (K) )/AA 


EN (K+1) 
AA + 1.0E@ 
K+ 1 


AA = 
K = 


25@ CONTINUE 


RETURN 


a 


26@ WRITE (LUN,99999) 


RETURN 


270 WRITE (LUN, 99998) 


RETURN 


280 WRITE (LUN,99997) 


RETURN 


290 WRITE (LUN,99996) 


RETURN 


300 WRITE (LUN,99995) 


RETURN 


31@ WRITE (LUN,99994) 


RETURN 


320 WRITE (LUN, 99993) 


RETURN 


33@ WRITE (LUN,99992) 


RETURN 


34@ WRITE (LUN,99991) 


RETURN 
99999 FORMAT 
99998 FORMAT 
99997 FORMAT 
99996 FORMAT 
99995 FORMAT 
99994 FORMAT 


(32H 
(27H 
(32H 
(33H 
(37H 
(46H 


IN 
IN 
IN 
IN 
IN 
IN 


EXPINT, N NOT GREATER THAN @) 

EXPINT, KODE NOT 1 OR 2) 

EXPINT, M NOT GREATER THAN @) 

EXPINT, TOL NOT WITHIN LIMITS) 

EXPINT, X IS NOT ZERO OR POSITIVE) 

EXPINT, THE EXPONENTLAL INTEGRAL IS NOT DE, 


* 21HFINED FOR X=@ AND N=1) 

99993 FORMAT (46H IN EXPINT, RELATIVE ERROR TEST FOR SERIES TER, 
* 28HMINATION NOT MET IN 36 TERMS) 

99992 FORMAT (46H LN EXPINT, TERMINATLON TEST FOR MILLER ALGORL, 
* 23HTHM NOT MET LN 99 STEPS) 

99991 FORMAT (46H IN EXPINT, AN ERROR IN PLACLNG INT(X+@.5) WIT, 
* 47HH RESPECT TO N AND N+M-1 OCCURRED FOR X.GT.XCUT) 


END 


FUNCTLON DIGAM(N) 


aAagAaAAN 


THIS SUBROUTINE RETURNS VALUES OF PSI(X)=DERIVATIVE OF LOG 
GAMMA(X), X.GT.@.@ AT INTEGER ARGUMENTS. A TABLE LOOK-UP LS 
PERFORMED FOR N.LE.1@@, AND THE ASYMPTOTIC EXPANSION IS 
EVALUATED FOR N.GT.100. 


DLMENSION B(4), C(1@@), C1(32), C2(27), C3(22), C4(19) 
EQUIVALENCE (C(1),C1(1)) 

EQUIVALENCE (C(33),C2(1)) 

EQUIVALENCE (C(6@),C3(1)) 

EQUIVALENCE (C(82),C4(1)) 


DATA Cl /-5. 772156649915 3E-@1, 4. 2278433569846 7E-@1, 


+ % & 


ee ee He 
WWWNYNN DM 


9. 2278433509846 7E-@1, 1. 256117668431 80E+OO, 1. 5061176684318GE+OO, 
- 7661176684318GE+9G, 1. 87278433509847E+OO, 2.01564147795561E+O0, 
- 14964147795561LE+O@, 2. 251752589966 72E+0G, 2. 351752589066 72E+O0, 
-44266167997581E+O@, 2. 525995013309 15E+OO, 2, 60291869923222E+0G, 
-67434666166079EtOO, 2. 74101332832 746E+OO, 2. 80351332832 746E+OO, 
- 862 3368577392 3EtOO, 2. 917892413294 78E+OO, 2.97952 399224215E+OG, 
-02052399224215E+OO, 3. 068143639861 2GE+OO, 3. 113597585315 74E+OO, 
. 1570758461853 1E+OO, 3. 19874251285197E+GO, 3. 23874251285197E+OO, 
» 27720405131 351 E+9O, 3. 31424168835055E+OO, 3. 34995537406484E+ OG, 


EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
[EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 
EXP 


DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
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COLLECTED ALGORITHMS (cont.) 


QO OO A Gia oO 


* 


ee SF He + HF pe ae a a a a 


FEE HE HRPHHEHE RHR RBEHEPWWWWWwWwWw 


+e Se eH 


x 


10 


20 
30 


10 


3. 3844381326855 2E+OQ, 3. 41777146601 886E+OO, 3. 4500295 305 3499E+O0/ 
DATA C2 /3. 4812795 3053499EtOO, 3. 5115825608 38Q2Et+ OO, 

- 54099432554 39GE+O@, 3. 569565754115 33EtOO, 3.59734353189311E+OO, 
«6243705589201 3E+0O, 3. 650686 34839382E+OO, 3.67632737403484Et 00, 
. 70132737403484E+OO, 3. 72571761793728EtOO, 3. 749527141 74681E+OO, 
. 772782955 70029E+OO, 3. 79551022842757E+0O0, 3. 817732450649 79E+GO, 
. 8394715810845 7E+OO, 3. 860748176829 25EtGO, 3.881581519016259E+GO, 
. 99198967342 789E+9O, 3. 92198967 342789E+OO, 3.94159751656515E+0O, 
- 960828285 7959 2E+OO, 3. 979696 21032422E+OO, 3. 998214728842 74E+OO, 
- 9163965470245 5E+0O, 4. 034253689881 7OE+OO, 4.0517975495 3682E+OO, 
- 0690389 288411 7E+OG/ 
TA C3 /4.08598808138354E+GO, 4. 1026547480502GE+00, 

. 11904819667 316E+OO, 4. 13517722293122E+GG, 4. 15195023880424E+OO, 
. 1666752 3880424E+0O, 4. 1820598541 8885EtOO, 4. 19721136934037E+OO, 
. 212136742474 7GE+OO, 4. 22684262482 764 E+OO, 4. 24133537845082Et+OO, 
-25562109273654E+0O, 4. 2697905599778 79E+GO, 4. 28359448866 768E+00, 
. 2972931188046 7E+OO, 4. 310806632 31818E+O0, 4. 32413996565151E+OO, 
. 33729786038836EtOO, 4. 350284873375 37EtOO, 4. 363105386195 88Et+OO, 
. 375 76 361404 39 8E+OO, 4. 38826 361404398E+00/ 
TA C4 /4.40960929305633E+0O, 4. 41280441500755E+00, 

- 4248526077786 3E+0O, 4. 4367573696 8340E+OO, 4.44852 2067556575E+OO, 
-46014998254249E+00, 4. 4716442354 1606E+O0, 4. 48306787177969E+00, 
- 494 243826 8358 7Et OO, 4. 50535493794698EtOO, 4. 5163439489 3599E+00, 
© 52721351415 338E+O@, 4. 5379662023254 3E+ 00, 4. 54860450019777E+00, 
- 55913081598 724E+00, 4. 56954748265 391 E+ OO, 4. 5798567610044 2E+00, 
- 59900608426 3708E+OO, 4. 60016185273809E+GG/ 


D 


D 


DATA B /1.66666666666667E-@1, -3. 33333333333333E-62, 
2. 38095238095 238E-02, -3. 33333333333333E-62/ 


IF (N.CT.10@) GO TO 1@ 
DIGAM = C(N) 


RETURN 
FN = N 
AX = 1.0E@ 
AK = 2.QE@ 


S = -@.5E@/FN 
IF (FN.GT.1.E+8) GO TO 30 
FN2 = FN*FN 
DO 2¢ K=1,3 
AX = AX*FN2 
S = S — B(K)/(AX*AK) 
AK = AK + 2. GEO 
CONTINUE 
CONTINUE 
DIGAM = S + ALOG(FN) 
RETURN 
END 


PROGRAM TSTEXP (INPUT, OUTPUT, TAPE3=OUTPUT ) 


DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 
DIG 


240 
250 
260 
270 
286 
290 
300 
310 
320 
330 
349 
350 
36¢ 
370 
380 
396 
400 
41 
42 
430 
440 
450 
460 
470 
480 
490 
500 
51¢ 
526 
539 
546 
556 
560 
57@ 
580 
590 
6060 
61¢ 
620 
630 
640 
650 
660 
670 
680 
690 
700 
716 


00000010 


PROGRAM TO TEST SUBROUTINE EXPINT AGAINST AN ADAPTIVE QUADRATURE. 
PARAMETER VALUES ARE PRINTED AND, 


IN THE EVENT THAT THE RELATIVE 


ERROR TEST IS NOT SATISFIED, X, ERROR, N, AND KODE ARE ALSO 


PRINTED. AN OUTPUT WITH ONLY PARAMETER VALUES INDICATES THAT ALL 


TESTS WERE PASSED. GAUS8 COMPUTES THE QUADRATURES. 


DIMENSION XTOL(1@), EN(5@), EV(50) 


IOUT = 3 

NL = 1 

NU = 16 

NINC = 5 

ML = 1 

MU = 25 

MINC = 8 

KM = 5 

JL=l1 

JU = 4@ 

JINC = 3 

XTOL(1) = 1.@E-2 

DO 1@ I=2,3 
XTOL(I) = XTOL(I-1)*1. @E-3 

CONT INUE 


DO 8@ IT=1,3 
TOL = XTOL(IT) 


09000020 
99000030 
00000040 
DOOOOO5O 
10000060 
00000070 
999000080 
00900090 
00000100 
00000110 
00000120 
60000130 
0000140 
00000150 
00000160 
900001 70 
00000180 
00000190 
00000200 
00000210 
90900220 
90009230 
90000240 
99000250 
09000260 


556-P 7 - 


0 


COLLECTED ALGORITHMS (cont.) 


Q 


26 


30 


10 


20 


AMAX1(1.@E-12, TOL/10. OE@) 


WRITE (LOUT,99999) TOL 
DO 70 M=ML,MU,MINC 
WRITE (IOUT,99998) M 
DO 6@ N=NL,NU,NINC 
WRITE (IOUT, 99997) N 
DO 5@ J=JL,JU,JINC 
X = FLOAT(J-1)/5.QE@ 
EX = EXP(-X) 
LF (X.EQ.@. .AND. N.EQ.1) GO TO 5@ 
CALL EXPINT(X, N, 1, M, TOL, EN, IERR) 
CALL EXPINT(X, N, 2, M, TOL, EV, IER) 
DO 4@ K=1,M,KM 
IF (X.GT.@.) GO TO 2 
LF (N+K.EQ.2) GO TO 4¢ 
Y = 1.@E@/FLOAT(N+K-2) 
YY = Y 
GO TO 3¢ 
CONTINUE 
NN=N+K—- 1 
YY = EINT(NN,X,TOLA, 2) 
Y = YY*EX 
CONTINUE 
ER = ABS((Y-EN(K))/Y) 
KODE = l 
IF (ER.GT.BTOL) WRITE (IOUT,99996) X, ER, NN, KODE 
KODE = 2 
ERR = ABS((YY-EV(K))/YY) 
IF (ERR.GT.BTOL) WRITE (IOUT,99996) X, ERR, NN, KODE 
CONTINUE 
CONTINUE 
CONTINUE 
CONTINUE 
CONTINUE 
STOP 
FORMAT (1H@, 
FORMAT (1H@, 
FORMAT (3X, 
FORMAT (2E15.6, 
END 


5H TOL=, E15.4/) 
2HM=, 15/) 

2HN=, I5) 

215) 


FUNCTION EINT(N, X, TOL, KODE) 
COMMON /GEINT/ XX, FN 
EXTERNAL FEINT 

XX = XK 


CONT INUE 

A=B8B 

REL = TOL 

B = B + SIG 

CALL GAUS8(FEINT, A, B, REL, ANS, IERR) 
S = S + ANS 

IF (ABS(ANS).LT.S*TOLA) GO TO 26 

GO TO 1@ 

EINT = S*EXP((FN-1.@E@)*ALOG (X)~—FLOAT (2~KODE)*X) 
RETURN 

END 


FUNCTION FEINT(T) 

COMMON /GEINT/ XX, FN 

FEINT = EXP(-T+XX-FN*ALOG(T) ) 
RETURN 

END 


SUBROUTINE GAUS8 (FUN,A,B,ERR,ANS,IERR) 


BY RONDALL E JONES, SANDIA LABORATORIES 


900060270 
00006280 
009000290 
00000300 
000006310 
00000326 
06900 330 
00000340 
06900350 
00000360 
069000370 
96000380 
09000390 
9OOGG400 
09060416 
00000420 
06000430 
AAOOO4L40 
00000450 
00000460 
00000470 
90000480 
90000490 
000006500 
99000510 
90000526 
09006530 
00000540 
00000550 
96000560 
00000570 
96000580 
90000590 
09O0G600 
00000610 
9OOOG6 20 
00000630 
00000640 
090090650 
009000660 
00000670 


00000680 
90000690 
00000700 
96000710 
00000720 
90000730 
00060740 
90000750 
00000760 
00000770 
90000780 
06000790 
9000800 
90900810 
90000820 
06000830 
10000840 
00090850 
90000860 
00000870 


00000880 
90009890 
00000900 
60000916 
9O9O09 20 


900009 30 
00000940 
06000950 


SALIENT FEATURES -- INTERVAL BISECTION, COMBINED RELATIVE/ABSOLUTE@$@0696@ 
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COLLECTED ALGORITHMS (cont.) 


C202 CF C3 OO 00 08 SE a OO OS OS Ea OO Oa OOO OOO AO a Oo eos 


ERROR CONTROL, COMPUTED MAXIMUM REFINEMENT LEVEL WHEN A IS 00000970 
CLOSE TO B. 60000980 
09900996 

ABSTRACT 00061600 
GAUS8 INTEGRATES REAL FUNCTIONS OF ONE VARIABLE OVER FINITE 90001910 
INTERVALS, USING AN ADAPTIVE 8-POINT LEGENDRE-GAUSS ALGORITHM. 90001420 
GAUS8 IS INTENDED PRIMARILY FOR HIGH ACCURACY INTEGRATION 000019306 

OR INTEGRATION OF SMOOTH FUNCTIONS. FOR LOWER ACCURACY 00001640 
INTEGRATION OF FUNCTIONS WHICH ARE NOT VERY SMOOTH, 00001050 
EITHER QNC3 OR QNC7 MAY BE MORE EFFICIENT. 006061660 
90001070 

DESCRIPTION OF ARGUMENTS $0001680 
069001090 

INPUT-- 90001100 
FUN - NAME OF EXTERNAL FUNCTION TO BE INTEGRATED. THIS NAME $0066111@ 
MUST BE IN AN EXTERNAL STATEMENT IN THE CALLING PROGRAM. 900011206 

FUN MUST BE A FUNCTION OF ONE REAL ARGUMENT. THE VALUE 660601130 

OF THE ARGUMENT TO FUN IS THE VARIABLE OF INTEGRATION 09091140 

WHICH RANGES FROM A TO B. 04001150 

A - LOWER LIMIT OF INTEGRAL 000601160 

B  - UPPER LIMIT OF INTEGRAL (MAY BE LESS THAN A) 00001170 
ERR - IS A REQUESTED ERROR TOLERANCE. NORMALLY PICK A VALUE OF@$60118@ 
ABS(ERR).LT.1.E-3. ANS WILL NORMALLY HAVE NO MORE ERROR $0606061190@ 

THAN ABS(ERR) TIMES THE INTEGRAL OF THE ABSOLUTE VALUE 906001200 

OF FUN(X). USUALLY, SMALLER VALUES FOR ERR YIELD 00001216 

MORE ACCURACY AND REQUIRE MORE FUNCTION EVALUATIONS. 00001220 

A NEGATIVE VALUE FOR ERR CAUSES AN ESTIMATE OF THE 000012306 
ABSOLUTE ERROR IN ANS TO BE RETURNED IN ERR. 00001240 

00001256 

OUTPUT-- 90001260 
ERR - WILL BE AN ESTIMATE OF THE ERROR IN ANS IF THE INPUT 000012706 
VALUE OF ERR WAS NEGATIVE. THE ESTIMATED ERROR IS SOLELYG60G@1280 

FOR INFORMATION TO THE USER AND SHOULD NOT BE USED AS 064601296 

A CORRECTION TO THE COMPUTED INTEGRAL. 90001300 

ANS - COMPUTED VALUE OF INTEGRAL 060061310 
LERR- A STATUS CODE 00001326 
--NORMAL CODES 066061330 

1 ANS MOST LIKELY MEETS REQUESTED ERROR TOLERANCE, 90001346 

OR. A=B. 04001356 

-1 A AND B ARE TOO NEARLY EQUAL TO ALLOW NORMAL 60001360 
INTEGRATION. ANS IS SET TO ZERO. 00001370 

--ABNORMAL CODE 00001380 

2 ANS PROBABLY DOES NOT MEET REQUESTED ERROR TOLERANCE. 4690139 

00001400 

00001410 

60001420 

GAUS8 USES SUBROUTINES ERRCHK, ERRGET, ERRPRT, ERXSET, ERSTGT 60001430 
COMPILE DECKS GAUS8, ERRCHK 00001440 
90001450 

DIMENSION AA(3@) ,HH( 30) ,LR(3@) , VL( 30) ,GR(3@) 00001460 
DATA X1, X2,X3,X4/@.18343 46424 95650 , @.52553 24999 16329 , 00061470 
1 @. 79666 64774 13627 , 6.96628 98564 97536 / 000901486 
DATA W1,W2,W3,W4/@. 36268 37833 78362 , 0.31370 66458 77887 , 00001496 
1 @.22238 16344 53374 , @.16122 85362 96376 / 00001500 
DATA $Q2/1.41421356/, ICALL/@/ 00001510 
DATA NLMN/1/,NLMX/30/,KMX/5000/, KML/6/,NBITS/48/ 000901520 
G8(X,H) = H*( (W1* (FUN (X~X1*H)+FUN (X+X1*H) ) 006001536 
i +W2* (FUN (X-X2*H)+FUN (X+X2*H) ) ) 00001540 
2 + (W3%* (FUN (X—X3*H)+FUN (X+X 3*H) ) 00001550 
3 +W4%* (FUN (X-X4*H) +FUN (X+X4*H))) ) 00001560 
00001570 

INITIALIZE 06001580 
00001590 

IF (ICALL.NE.@)CALL ERRCHK(-71, 7LH*****GAUS8 CALLED RECURSIVELY. RG0001600 
LECURSIVE CALLS ARE ILLEGAL IN FORTRAN. ) 60601616 
ICALL = 1 00001626 
ANS = 0.0 00001630 
IERR = 1 00001640 
CE = 0.6 00001650 
LF (A.EQ.B) GO TO 35 00001660 
LMX = NLMX 00001670 
LMN = NLMN 00001686 
IF (B.EQ.@.@) GO TO 4 00001690 
IF (SIGN(1.0,B)*A.LE.@.@) GO TO 4 00001700 
C = ABS(1.@-A/B) 00001716 
IF (C.GT.@.1) GO TO 4 0600172 
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COLLECTED ALGORITHMS (cont.) 


io) 


ory 


a 


AO a 


co 


LF (C.LE.@.@) GO TO 35 00001730 
NIB = @.5-ALOG(C) /ALOG(2.0) 00001740 
LMX = MIN@(NLMX , NBITS-NIB-7) 00001756 

IF (LMX.LT.1) GO TO 32 00001760 
LMN = MIN@(LMN, LMX) 00001776 

4 TOL = AMAX1(ABS(ERR) , 2. 0** (5-NBITS))/2.@ 00001780 
IF (ERR.EQ.@.@) TOL = @.5E-6 000017990 
EPS = TOL 90001800 
HH(1) = (B-A)/4.@ 00001810 
AA(1) =A 00001820 
LR(1) = 1 00601830 
L=1 00601840 
EST = G8(AA(L)+2. @*HH(L) ,2.@*HH(L)) 00901850 
k= 8 00001860 
AREA = ABS (EST) 06001870 
EF = @.5 00001880 
MXL = @ 00001896 
06001900 

COMPUTE REFINED ESTIMATES, ESTIMATE THE ERROR, ETC. 00001910 
00001920 

5 GL = G8(AA(L)+HH(L), HH(L)) 90001930 
GR(L) = G8(AA(L)+3. @*HH(L) ,HH(L) ) 00001940 

K = K+16 00001950 
AREA = AREA+(ABS(GL)+ABS(GR(L) )-ABS (EST) ) 00001960 

IF (L.LT.LMN) GO TO 11 06001976 
GLR = GL+GR(L) 00001980 

EF = ABS (EST-GLR)*EF 00001990 

AE = AMAX1(EPS*AREA, TOL*ABS (GLR) ) 90002000 

IF (EE-AE) 8,8,10@ 09002016 

7 MXL = 1 00002026 
8 CE = CE + (EST-GLR) 060602030 
IF (LR(L)) 15,15, 2¢ 90002040 
00002050 

CONSIDER THE LEFT HALF OF THIS LEVEL 00002060 
0060062070 

1@ IF (K.GT.KMX) LMX = KML 906020686 
IF (L.GE.LMX) GO TO 7 096002090 

11 L = Il 90002100 
EPS = EPS*@.5 00002110 

EF = EF/SQ2 090002126 
HH(L) = HH(L-1)*@.5 00002130 
LR(L) = -1 00002140 
AA(L) = AA(L-1) 90002150 
EST = GL 000062160 

GO TO 5 00002170 
00002186 

PROCEED TO RIGHT HALF AT THIS LEVEL 90002190 
00002200 

15,VL(L) = GLR 00002210 
16 EST = GR(L-1) 00002220 
LR(L) = 1 0909002236 
AA(L) = AA(L)+4. O*HH(L) 00602240 

GO TO 5 00002250 
00002260 

RETURN ONE LEVEL 00902270 
00002280 

2@ VR = GLR 06062290 
22 IF (L.LE.1) GO TO 3¢ 000623060 
L = L-1 00002310 
EPS = EPS*2.@ 60002320 

EF = EF*SQ2 09002330 

IF (LR(L)) 24, 24, 26 00002340 

24 VL(L) = VL(L+1)+VR 00002350 
GO TO 16 000062360 

26 VR = VL(L+1)+VR 00002370 
GO TO 22 00002386 
00002390 

EXIT 060024060 
00002410 

36 ANS = VR 00062420 
IF ((MXL.EQ.@).OR. (ABS(CE).LE.2.@*TOL*AREA)) GO TO 35 90002430 
IERR = 2 00062440 
CALL ERRCHK(51,51HIN GAUS8 , ANS IS PROBABLY INSUFFICIENTLY ACCURAQ@$0@245@ 
LTE.) 00002460 
GO TO 35 00002476 
32 LERR =~1 60002480 
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CALL ONECHK(-7@, 7@HTHE FOLLOWING TEMPORARY INFORMATIVE DIAGNOSTIC 00902490 
+ WILL APPEAR ONLY ONCE. ) 
CALLONECHK (- 192, 1@2HIN GAUS8 , A AND B ARE TOO NEARLY EQUAL TO ALLG@O6@2516 


ANNAN AADAKDANKDAAANMAANAANAANAAANNAANANAAANANAAAAAANAAN 


Q 


35 


10 


10W NORMAL INTEGRATION. 
) 


ICALL = 


ANS IS SET TO ZERO, AND IERR=-1.) 


IF (ERR.LT.@.@) ERR = CE 


RETURN 
END 


SUBROUTINE ERRCHK (NCHARS , NARRAY) 


SANDIA MATHEMATICAL PROGRAM LIBRARY 
APPLIED MATHEMATICS DIVISION 2642 
SANDIA LABORATORIES 

ALBUQUERQUE, NEW MEXICO 87115 


SIMPLIFIED VERSION FOR STAND-ALONE USE. 


ABSTRACT 


APRIL 1977 


THE ROUTINES ERRCHK, ERXSET, AND ERRGET TOGETHER PROVIDE 
A UNIFORM METHOD WITH SEVERAL OPTIONS FOR THE PROCESSING 
OF DIAGNOSTICS AND WARNING MESSAGES WHICH ORIGINATE 

IN THE MATHEMATICAL PROGRAM LIBRARY ROUTINES. 

ERRCHK IS THE CENTRAL ROUTINE, WHICH ACTUALLY PROCESSES 


MESSAGES. 


DESCRIPTION OF ARGUMENTS 
NCHARS ~ NUMBER OF CHARACTERS IN HOLLERITH MESSAGE. 


NARRAY - 


EXAMPLES 


IF NCHARS IS NEGATED, ERRCHK WILL UNCONDITIONALLY 
PRINT THE MESSAGE AND STOP EXECUTION. OTHERWISE, 
THE BEHAVIOR OF ERRCHK MAY BE CONTROLLED BY 

AN APPROPRIATE CALL TO ERXSET. 

NAME OF ARRAY OR VARIABLE CONTAINING THE MESSAGE, 
OR ELSE A LITERAL HOLLERITH CONSTANT CONTAINING 
THE MESSAGE. BY CONVENTION, ALL MESSAGES SHOULD 
BEGIN WITH *IN SUBNAM, ...*, WHERE SUBNAM IS THE 
NAME OF THE ROUTINE CALLING ERRCHK. 


1. TO ALLOW CONTROL BY CALLING ERXSET, USE 
CALL ERRCHK (30, 36HIN QUAD, INVALID VALUE OF ERR.) 


2. TO UNCONDITIONALLY PRINT A MESSAGE AND STOP EXECUTION, USE 
CALL ERRCHK(- 30, 3@HIN QUAD, 


INVALID VALUE OF ERR.) 


ERRCHK USES SUBROUTINES ERRGET, ERRPRT, ERXSET, ERSTGT 
COMPILE DECKS ERRCHK 


DIMENSION NARRAY (14) 


LOUT=6 


CALL ERRGET (NF ,NT) 
IF ERRCHK WAS CALLED WITH NEGATIVE CHARACTER COUNT, SET FATAL FLAGQ@@0630610 
IF (NCHARS.LT.@) NF = -1 

IF MESSAGES ARE TO BE SUPPRESSED, RETURN 

IF (NF.EQ.@) RETURN 

IF CHARACTER COUNT IS INVALID, STOP 

IF (NCHARS.EQ.@) PRINT 5 

LF (NCHARS .EQ. 6) WRITE (IOUT,5) 

FORMAT (/31H ERRCHK WAS CALLED INCORRECTLY.) 
IF (NCHARS.EQ.@) STOP 

PRINT MESSAGE 

CALL ERRPRT(IABS (NCHARS) , NARRAY) 


IF LAST MESSAGE, 


SAY SO 


IF (NF.EQ.1) PRINT 10 

IF (NF .EQ. 1) WRITE (IOUT,1@) 

FORMAT (3@H ERRCHK MESSAGE LIMIT REACHED. ) 

PRINT TRACE-BACK IF ASKED TO 

IF ((NT.GT.@).OR.(NF.LT.@)) CALL SYSTEM ROUTINE FOR TRACEBACK 
DECREMENT MESSAGE COUNT 

IF (NF.GT.0) NF = NF-1 

CALL ERXSET(NF,NT) 

IF ALL 1S WELL, RETURN 

IF (NF.GE.@) RETURN 


00662500 


00002520 
00002530 
00002540 
00002550 
60002560 


00002570 
00062580 
00002590 
00002600 
09002610 
09062620 
09002630 
00002640 
00002656 
06002660 
00002670 
009002680 
00002699 
00002700 
06002710 
00002720 
060062730 
00002740 
06002750 
09002760 
06002770 
90002780 
09002790 
000028060 
09002810 
00002826 
00002830 
00002840 
00002850 
00002860 
00002870 
00002886 
$006062890 
00002960 
009002910 
06002920 
0000629 30 
00002940 
00002950 
00002960 
00062970 
00062980 
00002990 
09003000 


000630620 
0003030 
00003046 
00003056 
0003060 
00003070 
0063080 
00003090 
60003100 
60003110 
00003120 
0063130 
00003140 
00003150 
0003160 
60003170 
00003180 
00003190 
00003200 
00003210 
00003226 
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cy 


AO). FAL COO AO OO. CF OO OO OOO A. OO OO 


IF THIS MESSAGE IS SUPPRESSABLE BY AN ERXSET CALL, 
THEN EXPLAIN ERXSET USAGE. 

IF (NCHARS.GT.@) PRINT 15 

IF (NCHARS .GT. 6) WRITE (IOUT,15) 


15 FORMAT (/13H *** NOTE *** 


1/53H TO MAKE THE ERROR MESSAGE PRINTED ABOVE BE NONFATAL, 
2/39H OR TO SUPPRESS THE MESSAGE COMPLETELY, 

3/37H INSERT AN APPROPRIATE CALL TO ERXSET 

4,30H AT THE START OF YOUR PROGRAM. 


000603230 
90903240 
0003250 
00003260 
00003270 
00003280 
90903290 
90003300 
00603310 


5/62H FOR EXAMPLE, TO PRINT UP TO 10 NONFATAL WARNING MESSAGES, USE@600332@ 


6/27H 
PRINT 20 
WRITE (LOUT, 20) 


CALL ERXSET(1@,@) ) 


20 FORMAT (/28H PROGRAM ABORT DUE TO ERROR.) 


STOP 
END 


SUBROUTINE ONECHK (NCHARS , NARRAY ) 


ABSTRACT 
ONECHK IS A COMPANION ROUTINE OF ERRCHK. IT IS CALLED 
JUST LIKE ERRCHK, AND MESSAGES FROM IT MAY BE SUPPRESSED 
BY AN APPROPRIATE CALL TO ERXSET. IT DIFFERS FROM ERRCHK 
IN THAT EACH CALL TO ONECHK WILL PRODUCE NO MORE THAN ONE 
PRINTED MESSAGE, REGARDLESS OF HOW MANY TIMES THAT CALL IS 
EXECUTED, AND ONECHK NEVER TERMINATES EXECUTION. 
ITS PURPOSE IS TO PROVIDE ONE-TIME-ONLY INFORMATIVE 
DIAGNOSTICS. 


DESCRIPTION OF ARGUMENTS 
NCHARS - NUMBER OF CHARACTERS IN THE MESSAGE. 
IF NEGATED, THE MESSAGE WILL BE PRINTED (ONCE) EVEN 
IF NFATAL HAS BEEN SET TO @ (SEE ERXSET). 
NARRAY - SAME AS IN ERRCHK 


ONECHK USES SUBROUTINES ERRGET, ERRPRT, ERXSET, ERSTGT 
COMPILE DECKS ERRCHK 


DIMENSION NARRAY (14) 

DATA NFLAG/4H.$, */ 

IF (NARRAY(1).EQ.NFLAG) RETURN 

CALL ERRGET(NF,NT) 

IF ((NF.EQ.@).AND. (NCHARS.GT.@)) RETURN 


00003330 
09003340 
00903356 
90003360 
00003370 
00603380 


009003390 
00003400 
09003410 
00003420 
069003430 
00003440 
00003450 
00003460 
00003470 
00003480 
00003490 
09003500 
60003510 
09003520 
000035 30 
00003540 
06003550 
00003560 
00003570 
006003580 
00003590 
06003600 
00903610 
009003620 
0090 3630 
009063640 
00003650 
$000 3660 


CALL ERRPRT (59, 59HTHE FOLLOWING INFORMATIVE DIAGNOSTIC WILL APPEAG@46367¢ 


LR ONLY ONCE.) 

CALL ERRPRT(IABS (NCHARS) , NARRAY ) 
IF (NF.GT.@) NF = NF-1 

CALL ERXSET(NF,NT) 

NARRAY (1) = NFLAG 

RETURN 

END 


SUBROUTINE ERRPRT(NCHARS , NARRAY ) 


UTILITY ROUTINE TO SIMPLY PRINT THE HOLLERITH MESSAGE IN NARRAY, 
WHOSE LENGTH IS NCHARS CHARACTERS. 


DIMENSION NARRAY (14) 


NOTE - NCH MUST BE THE NUMBER OF HOLLERITH CHARACTERS STORED 
PER WORD. IF NCH IS CHANGED, FORMAT 1 MUST ALSO BE 
CHANGED CORRESPONDINGLY. 


LOUT=6 
NCH = 10 
FOR LINE PRINTERS, USE 


1 FORMAT (1X,13A1@) 


FOR DATA TERMINALS, USE 


1 FORMAT (1X, 7A1@) 


NWORDS = (NCHARS+NCH-1)/NCH 
PRINT 1, (NARRAY (I) , I=1,NWORDS) 


00003680 
00003690 
60003700 
00003716 
00603720 
00003730 
60003740 


09003750 
06003760 
000603770 
09003780 
00003790 
00003800 
06003810 
00003820 
09003830 
06003840 
09003850 
009003860 
00903870 
06003880 
006003890 
00003900 
00003910 
0990039 20 
000039 30 
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WRITE (IOUT,1) (NARRAY(I),I=1,NWORDS) 00003940 
RETURN 00003956 
END 00003960 
SUBROUTINE ERXSET(NFATAL ,NTRACE) 006003970 
06003986 

ABSTRACT 00003990 
ERXSET IS A COMPANION ROUTINE TO SUBROUTINE ERRCHK. 00004000 
ERXSET ASSIGNS THE VALUES OF NFATAL AND NTRACE RESPECTIVELY 00004010 

TO NF AND NT IN COMMON BLOCK MLBLK@ THEREBY SPECIFYING THE 00004020 
STATE OF THE OPTIONS WHICH CONTROL THE EXECUTION OF ERRCHK. 06004030 
90064040 

DESCRIPTION OF ARGUMENTS PONO4050 
BOTH ARGUMENTS ARE INPUT ARGUMENTS OF DATA TYPE INTEGER. 09004060 
NFATAL - IS A FATAL-ERROR / MESSAGE-LIMIT FLAG. A NEGATIVE 00004070 
VALUE DENOTES THAT DETECTED DIFFICULTIES ARE TO BE 0004080 

TREATED AS FATAL ERRORS. NONNEGATIVE MEANS NONFATAL .00006409@ 

A NONNEGATLVE VALUE IS THE MAXIMUM NUMBER OF NONFATAL@QG04106@ 

WARNING MESSAGES WHICH WILL BE PRINTED BY ERRCHK, 00604110 

AFTER WHICH NONFATAL MESSAGES WILL NOT BE PRINTED. 20004120 

(DEFAULT VALUE IS -1.) 009064130 

NTRACE -— .GE.1 WILL CAUSE A TRACE-BACK TO BE GIVEN, 00004146 

IF THIS FEATURE IS IMPLEMENTED ON THIS SYSTEM. 00004150 

.LE.@ WILL SUPPRESS ANY TRACE-BACK, EXCEPT FOR 00004166 

CASES WHEN EXECUTION IS TERMINATED. 00004170 

(DEFAULT VALUE IS @.) 09004180 

00904190 

*NOTE* -~ SOME CALLS TO ERRCHK WILL CAUSE UNCONDITIONAL 00004200 
TERMINATION OF EXECUTION. ERXSET HAS NO EFFECT ON SUCH CALLS .0¢006421@ 
00004226 

EXAMPLES 90004230 
1. TO PRINT UP TO 100 MESSAGES AS NONFATAL WARNINGS USE 000064240 
CALL ERXSET (100, 9) 90004250 

2. TO SUPPRESS ALL MATHLIB WARNING MESSAGES USE 60004266 
CALL ERXSET(@,@) 000064270 
00064280 

00004299 

99004 300 

ERXSET USES SUBROUTINES ERSTGT 00004316 
COMPILE DECKS ERRCHK 00004320 
900064330 

CALL ERSTGT(@, NFATAL, NTRACE) 60004 340 
RETURN 00004350 
END 00004360 
SUBROUTINE ERRGET (NFATAL,NTRACE) 000064370 
009G4 380 

ABSTRACT 00004 390 
ERRGET IS A COMPANION ROUTINE TO SUBROUTINE ERRCHK. 00004400 
ERRGET ASSIGNS TO NFATAL AND NTRACE RESPECTIVELY THE VALUES 600604410 

OF NF AND NT IN COMMON BLOCK MLBLK@ THEREBY ASCERTAINING THE 6406064420 
STATE OF THE OPTIONS WHICH CONTROL THE EXECUTION OF ERRCHK. 600604430 
00004440 

DESCRIPTION OF ARGUMENTS 06004450 
DESCRIPTION OF ARGUMENTS 90004450 
BOTH ARGUMENTS ARE OUTPUT ARGUMENTS OF DATA TYPE INTEGER. 00004460 
NFATAL - CURRENT VALUE OF NF (SEE DESCRIPTION OF ERXSET.) 00004470 
NTRACE - CURRENT VALUE OF NT (SEE DESCRIPTION OF ERXSET.) 00004480 
00004490 

CALL ERSTGT (1, NFATAL, NTRACE) 000904500 
RETURN 00004510 
END 006004526 
SUBROUTINE ERSTGT(K,NFATAL , NTRACE) 00004530 
00004540 

THIS ROUTINE IS A SLAVE TO ERRGET AND ERRSET WHICH KEEPS 00064550 
THE FLAGS AS LOCAL VARIABLES. 00004560 
00004570 

*xk*k IF LOCAL VARIABLES ARE NOT NORMALLY RETAINED BETWEEN 00004580 
CALLS ON THIS SYSTEM, THE VARIABLES LNF AND LNT CAN BE 60004590 
PLACED IN A COMMON BLOCK AND PRESET TO THE FOLLOWING $006064600 
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QO 


VALUES IN THE MAIN PROGRAM. 


DATA LNF/-1/,LNT/@/ 

LF (K.LE.@) LNF = NFATAL 
IF (K.LE.@) LNT = NTRACE 
IF (K.GT.@) NFATAL = LNF 
IF (K.GI.@) NTRACE = LNT 
RETURN 

END 


00004616 
00004620 
00004636 
00004640 
00004650 
00004660 
90904670 
00004680 
00004690 
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ALGORITHM 557 
PAGP, A Partitioning Algorithm for (Linear) 
Goal Programming Problems [H] 


JEFFREY L. ARTHUR 
Oregon State University 
and 

A. RAVINDRAN 
Purdue University 


Key Words and Phrases: goal program, multiple objective optimization, constraint partitioning, 
simplex method 

CR Categories: 5.41 

Language: Fortran 


DESCRIPTION 
This algorithm is a Fortran implementation of the procedures developed in [1]. 


REFERENCE 


1. ARTHUR, J.L., AND RAVINDRAN, A. PAGP, A partitioning algorithm for (linear) goal program- 
ming problems. ACM Trans. Math. Softw. 6, 3 (Sept. 1980), 378-386. 


ALGORITHM 


PROGRAM MALN (INPUT,OUTPUT, TAPE5=LNPUT, TAPE6=OUTPUT) A 1g 
HR KK ERI RI RE RE KER IRIS RIL IIIB IIR II IRI II III IISA IE III II IKI IKI 


RKKK 
RKKKK 


xkk* PAGP (THE PARTITIONING ALGORITHM FOR GOAL PROGRAMMING) IS 

xk DESIGNED TO SOLVE THE LINEAR GOAL PROGRAMMING PROBLEM. THE 

x*kk ALGORITHM PARTITIONS THE GOAL CONSTRAINTS OF THE PROBLEM 

x**k*K ACCORDING TO THE HIGHEST PRIORITY ASSIGNED TO EITHER DEVIATIONAL 
*x*kk* VARIABLE (D- OR D+) IN EACH GOAL. THE ALGORITHM IS THUS ABLE TO 
«kk SOLVE A SEQUENCE OF SMALLER PROBLEMS IN ORDER TO FIND A SOLUTION 


x*kk* TO THE ORIGINAL PROBLEM. 
kK 


ARK 
HHKKKK KEE KERR ERR ERE RRR RRR ARERR IKK REIKI KIER REIKI RE RIE REERK 
KRAK 

RAKK 

**k*k* MUCH OF THE NOTATION AND STRUCTURE OF THE PAGP CODE IS TAKEN 

“xx (WITH THE AUTHOR'S PERMISSION) FROM THE LINEAR GOAL PROGRAMMING 


QAAGQDARAAANAANAARANANANAAAAN 
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AMARQRANRAKRANANAAAMCAAnNneGnaeaaanKnAMAnaNnAaAnanMANnNANNMNANMMANMAMAAMANMNANMNANANAANANNAMAAAAAMAAKNAAAANANAAAAAnA NS 


*#kXK CODE GIVEN IN 


Fedode ds 


RAK IGNIZIO,J.P., GOAL PROGRAMMING AND EXTENSIONS, 
FETC ie ic I a a a Se ss a en es 
RRR D.C.HEATH AND CO., LEXINGTON,MA(1976) 

KEKE 

KEKE 


KITT II KKK IKK IKKE RIKI KK RIKKI KER ERR IKIE RK ERE ERE REKEKERREREREKE 
weeks 

keEKK 

**kk% THE CODE FOR PAGP USES THE FOLLOWING ARRAYS- 

ARK 


Tekdek TE(NROW,NCOL) = THE COEFFICIENT OF THE VARIABLE IN 

KKK COLUMN NCOL IN THE CCNSTRAINT IN ROW NROW 
temkakk 

IKK TT (NP ,NCOL) = THE WEIGHT OF THE VARIABLE IN COLUMN NCOL 
kIKK AT PRIORITY NP 

KKK 

RK TBCNROW) = THE RIGHT HAND SIDE CONSTANT OF THE 
ARK CONSTRAINT IN ROW NROW 

wk ke 

RREKK TI, (NROW, NP) = THE WEIGHT ASSIGNED TO THE BASIC VARIABLE 
kik IN ROW NROW AT PRIORITY NP 

KKK 

KKK TI (NP,NCOL) = THE RELATIVE WEIGHT OF THE VARIABLE IN 
kkk COLUMN NCOL AT PRIORITY NP 

weKAK 

RKKK TAC(NP) = THE TOTAL DEVIATION FROM THE GOALS AT 
teoekk PRIORITY NP 

RRKK 

RAK NC (NP) = THE NUMBER OF GOAL CONSTRAINTS ASSIGNED 
KKKK TO PRIORITY NP BY THE PARTITION 

kreAK 

REKK NCON(1I,NP) = THE SUBSCRIPT OF THE I-TH CONSTRAINT 
KAKK ASSIGNED TO PRIORITY NP (I=1,...,NC(NP)) 
ke 

KARE NTOF (NP ) = THE NUMBER OF TERMS IN THE OBJECTIVE 

Heke deve FUNCTION AT PRIORITY NP 

RAEKK 

keke LND (NCOL) = 1, IF THE VARIABLE IN COLUMN NCOL IS 
KkKE ELIGIBLE TO ENTER THE BASIS 

KEK = Qo, OTHERWISE 

AKKK 

REEK JROW(NROW,1) = THE TYPE OF BASIC VARIABLE IN ROW NROW, 
AKEK WHERE TYPE IS GIVEN BELOW 

RE 

RRAK TYPE JROW( . 41) 

KRaEK RKEK RRA KEKKKEKEAEKE 

ARKKK Xx 2 

keKK D+ 3 

aekevek D- 4 

KKK 

axKRK JROW(NROW,2) = THE SUBSCRIPT OF THE BASIC VARIABLE IN 
KEK ROW NROW 

aReRK 

RAK JCOL(NCOL,1) = THE TYPE OF VARIABLE IN COLUMN NCOL 
Kikk (TYPE IS DEFINED AS ABOVE) 

KEKE 

KKK JCOL(NCOL,2) = THE SUBSCRIPT OF THE VARIABLE IN 

KKK COLUMN NCOL 

KKKK 

kK 


KREKEKEEREREKERKKRKEERKRRRKERERKERKKREKRRRER EKER EREKRREREREREREERKKRERKRKER 
KAKK 
kkkere 


*k*AR AS PRESENTLY DIMENSIONED, THE PAGP CODE CAN SOLVE PROBLEMS WITH 
kkKK UP TO 6@ CONSTRAINTS (BOTH REAL + GOAL CONSTRAINTS), 125 


&*k*k*k VARIABLES (DECISION + DEVIATIONAL VARIABLES), AND 1@ PRIORITIES. 
wk 


RKKK 

RIKER EEK IKK KEK RRR KERR KERRIER EEE KERR ERRERERKKERERKERKERREKRKEREKREE 

KAKK 

KEEK 
COMMON TT(19,125) ,TB(60) , TE(60, 125) ,TL(60,10) ,TA(1@) , TI (16,125) ,JC 
1LOL(125, 2) ,NCOLI ,NROWL,NPRIC,NC(1@) , JROW(60, 2) ,NVAR,NPRIT, IND(125) 
COMMON /PHASE1/ W,NRCON,NDVR 


A 
A 
A 


20 
30 
40 
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aNgNAaANAANANAANM 


OO OO Oe OS OO 


aa CG) 


i?) 


CA 


COMMON /CHNG/ NCON(6@,106) ,NTOF(10) 
INTEGER ALTST 


*#kKX READ IN PROBLEM DATA 


RKEEK 

kkk NPRIT=THE TOTAL NUMBER OF PRIORITIES 

RKEK 

xk NVAR=THE TOTAL NUMBER OF DECISION VARIABLES (INCLUDING SLACK AND 
dite SURPLUS VARIABLES BUT EXCLUDING ARTIFICIAL VARIABLES FOR THE 
HH REAL CONSTRAINTS) 

KKAKK 


**** NRCON=THE NUMBER OF REAL CONSTRAINTS 


READ (5,120) NPRIT,NVAR,NRCON 
READ (5,121) (NC(NP),NP=1,NPRIT) 
DO 1@1 NP=1,NPRIT 
IF (NC(NP).EQ.@) GO TO 11 
NCTMP=NC (NP) 
READ (5,122) (NCON(N,NP) ,N=1,NCTMP) 
101 CONTINUE 
READ (5,121) (NTOF(NP) ,NP=1,NPRIT) 


xkkK TNITIALIZE SUBPROBLEM DIMENSIONS AND COLUMN INDICATORS. 
KK 

nae NCOLI=THE NUMBER OF COLUMNS IN THE CURRENT WORKING TABLEAU 
kkk 

ei NROWL=THE NUMBER OF ROWS IN THE CURRENT WORKING TABLEAU 

fe ve ek 

uae NPRIC=THE PRIORITY CURRENTLY BEING OPTIMIZED 

AK 


wAKK ZERO THE TE, TL, TT, AND TI ARRAYS. 


NCOLI=6@ 
NROWI=6 
NPRIC=@ 
DO 104 NCR=1,125 
IND(NCR)=1 
DO 162 NR=1,60 
102 TE (NR,NCR)=@. 
DO 103 NP=1,16 
TI(NP,NCR)=@. 
163 TT (NP,NCR)=@. 
104 CONTINUE 
DO 105 NR=1,6@ 
DO 105 NP=1,1¢ 
105 TLCNR,NP)=@. 


*kk* CHECK FOR REAL CONSTRAINTS. 


IF (NRCON.EQ.@) GO TO 196 
CALL PHSEL 

IF (NDVR.LE.@) GO TO 116 
IF (W.GT.@.) GO TO 117 


xkk* THE PARTITIONING ALGORITHM BEGINS. 


1@6 NPRIC=NPRIC+1 
LF (NPRIC.EQ.1.AND.NRCON.EQ.@) GO TO 167 
GO TO 108 
107 CALL READI 
GO TO 169 
168 CALL READ2 
109 CALL CINDX 
CALL TEST (NEVC,NDVR) 


xee* TF NEVC IS LESS THAN ZERO, THE SUBPROBLEM IS OPTIMIZED. 


IF (NEVC.LE.@) GO TO 11@ 


x*k*k* TF NDVR IS LESS THAN ZERO, NO MINIMUM POSITIVE RATIO WAS FOUND. 


IF (NDVR.LE.@) GO TO 116 
CALL PERM (NEVC,NDVR) 
GO TO 169 


##k* IP THERE ARE NO MORE PRIORITIES, TOTAL PROBLEM IS OPTIMIZED. 


> > > PS 


>> > > P 


>> > > 


rrr rrr errr Pre rer rer ere ere rere eer ere ere eee rer Pere Pere PP PP 


50 
60 
80 
90 


160 
1106 
12@ 
13@ 
140 


160 
176 
18¢ 
199 


200 
210 
220 
230 
240 
250 
260 
270 
280 
290 


300. 


316 
320 
330 
349 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 
470 
480 
490 
500 
519 
526 
530 
540 
550 
560 
570 
580 
590 
600 
616 
620 
630 
640 
650 
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aa 


ANAND 
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oO 


xxx PRINT THE OPTIMAL SOLUTION. 


11@ IF (NPRIC.EQ.NPRIT) GO TO 115 


kkk 
RKKK 
KKK 
kick 


1 
111 


SINCE THERE ARE MORE PRIORITIES, MOVE ON TO THE NEXT SUBPROBLEM 
IF THERE ARE ALTERNATE SOLUTIONS. FIRST, ELIMINATE THOSE 
COLUMNS WHICH CAN NOT ENTER THE BASIS. IF THERE ARE NO 
ALTERNATE SOLUTIONS, PRINT THE UNIQUE OPTIMAL SOLUTION. 


ALTST=@ 


DO 112 NCR=1,NCOLL 
IF (IND(NCR).EQ.@) GO TO 112 
IF (TI(NPRIC,NCR).GT.@.) GO TO 112 
DO 111 NR=1,NROWI 


CONTINUE 
ALTST=1 
112 CONTINUE 


IF (JROW(NR,1).EQ.JCOL(NCR,1).AND.JROW(NE, 2) .EQ.JCOL(NCR, 2) ) 
GO TO 112 


**x® TF ALTST=1, THERE ARE ALTERNATE SOLUTIONS. 


IF (ALTST.EQ.1) GO TO 113 
GO TO 115 


*k*X ELIMINATE THOSE COLUMNS WITH A POSITIVE RELATIVE COST AT 


*kKK PRIORITY NPRIC. 


113 DO 114 NCR=1,NCOLI 
114 IF (TI(NPRIC,NCR).GT.@.) IND(NCR)=0@ 
GO TO 196 


&xk*k*k THE OPTIMIZATION IS OVER. PRINT OUT THE FINAL SOLUTION. 


115 
116 


117 


118 
119 


120 
121 
122 
123 


CALL POUT 
GO TO 119 


WRITE 
GO TO 
WRITE 
WRITE 


(6,123) NPRIC 
119 
(6,124) W 
(6,125) 
DO 118 NR=1,NROWI 


WRITE (6,126) JROW(NR,1),JROW(NR,2),TB(NR) 
CONTINUE 


STOP 


FORMAT 
FORMAT 
FORMAT 
FORMAT 


(315) 
(1615) 
(1615) 
(/ 40H 


THE PROGRAM TERMINATED ON SUBPROBLEM ,I4, 42H NO 


1 MINIMUM POSITIVE RATIO COULD BE FOUND) 


124 FORMAT (/ 65H THE PROGRAM TERMINATED IN PHASE 1 WITH OBJECTIVE F 


1UNCTION VALUE, F15.4) 


125 FORMAT (/ 


1 ei 


END 


SUBROUTINE PHSE1 


55H THE OPTIMAL SOLUTION TO THE PHASE 1 PROBLEM IS 


6H TYPE,2X, 3HSUB,8X, 5HVALUE) 
126 FORMAT (215,F15.4) 


*kKK SUBROUTINE PHSE1 READS IN ANY REAL CONSTRAINTS AND PERFORMS A 
*kKK PHASE 1 SIMPLEX PROCEDURE IN ORDER TO FIND AN INITIAL BASIC 
xk FEASIBLE SOLUTION. 


KKK 


bO 1@1 NV=L,NVAR 
JCOL(NV, L)=2 


COMMON TT(1@,125) ,TB(6@) , TE(6@, 125) ,TL(6@, 10) ,TA(10) , TI (10,125) ,JC 
10L (125, 2) ,NCOLI,NROWI ,NPRIC,NC(10) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 
COMMON /PHASE1/ W,NRCON,NDVR 

DIMENSION C(125), CR(125), CB(60) 


SET COLUMN AND ROW HEADINGS 


1@1 JCOL(NV, 2)=NV 


DO 162 NR=L,NRCON 


rr PrP rr rrr rrr Pr reer errr PrP rrr Pr PLS 


PrP Pr > > > PP > 


> > > P 


> PP 


Dwmawmwonwrewrenonnwy 
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810 
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896 
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980 
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112@ 
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115@ 
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119¢ 
1220 
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oo cr Qaan 2) 


Oo 


aa 


Qa 


aa 


JROW (NR, L)=1 
JROW (NR, 2)=NR 
NAR=NVAR+NR 
JCOL (NAR, 1)=1 
1@2 JCOL(NAR, 2)=NR 


**k*kX READ IN COEFFICIENTS AND RHS OF REAL CONSTRAINTS 


DO 163 NR=1,NRCON 
READ (5,118) TB(NR), (TE(NR,NV) ,NV=1,NVAR) 
1@3 CONTINUE 


xk*kX PUT IDENTITY MATRIX IN FOR ARTIFICIAL VARIABLES 


DO 104 NR=1,NRCON 
NAR=NVAR+NR 
104 TE(NR,NAR)=1. 


xk SET C(J)=@ FOR ALL DECISION VARIABLES AND C(J)=1 FOR ALL 
KKK ARTIFICIAL VARIABLES 


DO 165 NV=1,NVAR 
105 C(NV)=¢. 

DO 1066 NR=1,NRCON 
CB(NR)=1. 
NAR=NVARHNR 

196 C(NAR)=1. 


*kkKK CALCULATE RELATIVE COST COEFFICIENTS CR(.) 


NCOL=NVAR+NRCON 
107 DO 168 NV=1,NCOL 
CR(NV)=C (NV) 
DO 168 NR=1,NRCON 
108 CR(NV)=CR(NV)-CB(NR) *TE(NR,NV) 


x*kKK CHECK FOR OPTIMALITY 


VEVC=¢@. 

NEVC=@ 

DO 109 NCO=1,NCOL 
NV=NCO 
IF (CR(NV).GE.@.) GO TO 109 
IF (CR(NV).GE.VEVC) GO TO 109 
VEVC=CR (NV) 
NEVC=NV 

169 CONTINUE 


*kKK TF NEVC=@, PHASE 1 IS OPTIMIZED. CALCULATE OBJECTIVE FUNCTION. 


IF (NEVC.EQ.@) GO TO 115 
xkkK DETERMINE DEPARTING VARIABLES ROW. 


NDVR=0 
VDVR=10. GE+20 
DO 111 NRI=1,NRCON 
NR=NRI 
IF (TE(NR,NEVC).LE.@.) GO TO 111 
V=TB (NR) /TE(NR,NEVC) 
LF (NDVR.EQ.6) GO TO 110 
IF (V-VDVR) 110,110,111 
110  VDVR=V 
NDVR=NR 
111 CONTINUE 


xk TF NDVR=@, MINIMUM RATIO RULE FAILED. RETURN. 
IF (NDVR.EQ.@) RETURN 

*#kk* PERFORM THE PIVOT. REPLACE HEADINGS AND COST COEFFICIENT. 
JROW (NDVR, 1)=JCOL(NEVC, 1) 


JROW (NDVR, 2)=JCOL(NEVC, 2) 
CB(NDVR)=C (NEVC) 


DRaAWWnWDdBWwnwnnnsn nnn ror rnwmnwnt dd Own ddownvsws dnd Dv Bd nsdn Dorn oTwnv Oe SOW ennwswsersnwsnwnnvsr sey 
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C 
C 


OO 


oO 


aAaAN 


GO 


AQ: OC: 2 


Qa 


C 
C 
C 


x*AKX COMPUTE NEW TE ARRAY 


PLV=TE (NDVR,NEVC) 
PLB=TB(NDVR) 
DO 113 NR=1,NRCON 
IF (NR.EQ.NDVR) GO TO 113 
LF (ABS (TE(NR,NEVC)).LE.@.0005) GO TO 113 
‘PLX=TE (NR,NEVC) /PIV 
TB (NR)=FIX(TB(NR)-PLX*PIB) 
DO 112 NV=1,NCOL 
112 TE (NR,NV)=FLX(TE(NR,NV)—-TE(NDVR,NV)*PLX) 
113 CONTINUE 
TB (NDVR)=FIX(PIB/PIV) 
DO 114 NV=1,NCOL 
114 TE(NDVR,NV)=FIX(TE(NDVR,NV)/PIV) 


*xk*kX END OF PIVOT OPERATIONS. PROCEED TO NEXT ITERATION. 
GO TO 107 

x*KX CALCULATE W, THE PHASE-1 OBJECTIVE FUNCTION. 

115 W=@. 
DO 116 NR=1,NRCON 

116 W=W+TB (NR) *CB (NR) 


#kAKK INITIALIZE THOSE PORTIONS OF THE TABLEAU ASSIGNED TO THE 
xxk*XK ARTIFICIAL VARIABLES. 


DO 117 NR=1,NRCON 
DO 117 NV=1,NCOL 
LF (NV.LE.NVAR) GO TO 117 
TE(NR,NV)=0. 
117 CONTINUE 


k*kKX UPDATE NCOLI AND NROWI PARAMETERS. 
NROWI=NRCON 


NCOLI=NVAR 
RETURN 


118 FORMAT (8F10.@) 


END 


SUBROUTINE READL 


k*kKK SUBROUTINE READ1 READS IN THE GOAL CONSTRAINTS AND OBJECTIVE 


*#*kxX* FUNCTION TERMS ASSIGNED TO PRIORITY ONE. 


*&x%%* SUBROUTINE READIL IS NOT USED IF REAL CONSTRAINTS ARE PRESENT. 


COMMON TT(1@,125),TB(60) , TE(6@, 125) ,TL(6@, 10) , TA(1@) , TI (10,125) ,JC 
10L(125,2) ,NCOLI,NROWI ,NPRIC,NC(10) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 


COMMON /CHNG/ NCON(6@, 10) ,NTOF(10) 
*&k* SET COLUMN AND ROW HEADINGS. 


DO 101 NV=1,NVAR 

JCOL(NV,1)=2 
191 JCOL (NV, 2)=NV 

NCLi=NC (1) 

DO 162 NCR=1,NC11 
NC1=NVAR+2*NCR-1 
NC2=NVAR+2*NCR 
JCOL(NC1,1)=4 
JCOL(NC1, 2)=NCON (NCR, 1) 
JCOL(NC2,1)=3 
JCOL(NC2, 2)=NCON (NCR, 1) 
JROW (NCR, 1)=4 

1@2 JROW(NCR, 2)=NCON (NCR, 1) 


*#*#** READ IN THE GOAL CONSTRAINTS ASSIGNED TO PRIORITY 1. 


NC1=NC(1) 
DO 103 NCR=1,NC1 
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oO 


an 


cA 


io 


Om oo 


aaanaaaa 


NV1=NVAR+2*NCR-1 
NV2=NVAR+2*NCR 


READ (5,145) TB(NCR), (TE(NCR,NV) ,NV=1,NVAR) 


xxx PUT +1 IN FOR D- AND -1 IN FOR Dt. 


TE(NCR,NV1)=1. 
TE(NCR,NV2)=-1. 


103 CONTINUE 


kkKK READ IN THE OBJECTIVE FUNCTION TERMS FOR PRIORITY 1. 


NCOLI=NV2 
NROWI=NC (1) 


NT1=NTOF (L) 
DO 104 NT=1,NT1 


READ (5,166) ISUB,ITYPE,WGHT 
CALL PLACE (ISUB,LTYPE,WGHT) 


164 CONTINUE 


RETURN 


105 FORMAT (8F1@.@) 
1@6 FORMAT (215,F10.@) 


KKKK 


kK 
KKKK 
KEKE 


KKK 


END 


SUBROUTINE READ2 


SUBROUTINE READ2 READS IN THE GOAL CONSTRAINTS AND OBJECTIVE 


FUNCTION TERMS ASSIGNED TO PRIORITY NPRIC. 


SUBROUTINE READ2 IS ALSO USED TO READ IN THE FIRST PRIORITY GOAL 
CONSTRAINTS AND OBJECTIVE FUNCTION TERMS IF REAL CONSTRAINTS ARE 


PRESENT. 


COMMON TT(1@,125) ,TB(60) ,TE(6@, 125) ,TL(60,16) ,TA(10) ,TI(1@,125) ,JC 
10L(125, 2) ,NCOLI,NROWI ,NPRIC,NC({10) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 
COMMON /CHNG/ NCON(60,1@) ,NTOF(10) 
TF (NC(NPRIC).EQ.@) GO TO 167 


***X READ IN THE COEFFICIENTS OF THE X'S. 


NCTMP=NC (NPRIC) 


DO 1¢6 NRI=1,NCTMP 


NR=NRI+NROWI 
NC1=NCOLI+2*NRI-1 
NC2=NCOLI+2*NRI 
JCOL(NC1,1)=4 

JCOL(NC1, 2)=NCON(NRI,NPRIC) 
JCOL(NC2, 1)=3 
JCOL(NC2, 2)=NCON (NRI,NPRIC) 


READ (5,169) TB(NR), (TE(NR,NV) ,NV=1,NVAR) 


TE(NR,NC1)=1. 
TE (NR,NC2)=-1. 


xk PERFORM THE ROW REDUCTION. 


101 


162 


**X*k DETERMINE THE DEVIATIONAL VARIABLE TO ENTER THE BASIS. 


**k*k SINCE TB IS LESS THAN ZERO, MULTIPLY THE ROW BY -1 AND ENTER D+ 


KKKK 


163 


DO 102 NRC=1,NROWI 
IF (JROW(NRC,1).NE.2) GO TO 192 
J=JROW (NRC, 2) 
TB(NR)=TB(NR)-TE(NR, J) *TB (NRC) 
DO 161 NCR=1,NC2 
LF (NCR.EQ.J) GO TO 161 


TE (NR,NCR)=TE (NR, NCR)-TE (NR, J) *TE(NRC,NCR) 


CONTINUE 
TE(NR,J)=0@. 
CONTINUE 


LF (TB(NR)) 163,105,105 


IN THE BASIS. 


DO 104 NCR=1,NC2 
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Qa 


a0 


QO C263 Cr ONG A-One 


Qa 


[pa 


pe ee Sa a 


104 


*xk*k* SINCE TB IS GREATER THAN OR EQUAL TO ZERO ENTER D- IN THE BASIS. 


105 


106 


wee TNCREASE THE PARAMETERS NCOLI AND NROWI. 


TE (NR, NCR)=-TE (NR, NCR) 
TB(NR)=-TB (NR) 

JROW (NR, 1)=3 

JROW (NR, 2)=NCON (NRI,NPRIC) 
GO TO 196 


JROW(NR,1)=4 
JROW (NR, 2)=NCON(NRI,NPRIC) 
CONTINUE 


NCOLI=NC2 
NROWI=NR 


**k*X READ IN THE OBJECTIVE FUNCTION TERMS FOR PRIORITY NPRIC. 


107 


108 


109 
11¢ 


KKEK 
RREK 
RKKK 
KEKE 
KREKK 
RAKRK 
KKKK 
RKKK 
REKK 
KKK 
KKK 


NTTMP=NTOF (NPRIC) 
DO 108 NT=1,NTTMP 
READ (5,110) ISUB,ITYPE,WGHT 
CALL PLACE (ISUB, LTYPE,WGHT) 
CONTINUE 
RETURN 


FORMAT (8F10. 4) 
FORMAT (215,F10.0) 


END 


SUBROUTINE PLACE (ISUB,ITYPE,WGHT) 


SUBROUTINE PLACE PUTS THE OBJECTIVE FUNCTION WEIGHTS FOR THE 


DEVIATION VARIABLES AT THE CURRENT PRIORITY LEVEL (NPRIC) IN THE 
CORRECT POSITIONS IN THE AUGMENTED TABLEAU. 


ISUB=THE SUBSCRIPT OF THE DEVIATIONAL VARIABLE 


ITYPE=3, IF POSITIVE DEVIATIONAL VARIABLE (D+) 
4, IF NEGATIVE DEVIATIONAL VARIABLE (D-) 


WGHT=THE CARDINAL WEIGHT OF THIS DEVIATIONAL VARIABLE AT THE 


CURRENT PRIORITY LEVEL 


COMMON TT(1@,125),TB(6@) , TE(6@, 125) ,TL(6@,10) ,TA(1@) , TI (10,125) , JC 
10L (125, 2) ,NCOLI,NROWL ,NPRIC,NC(1) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 
COMMON /CHNG/ NCON(6@, 10) ,NTOF(1@) 


*kkK PLACE THE WEIGHT IN THE PROPER COLUMN IN THE TOP STUB. 


1@1 
192 


NC1=NVAR+1 
DO 161 NCR=NC1,NCOLI 


LF (JCOL(NCR,1).EQ.ITYPE.AND.JCOL(NCR, 2).EQ.ISUB) GO TO 12 


CONTINUE 
TT (NPRIC,NCR)=WGHT 


**** PLACE THE WEIGHT IN THE PROPER ROW IN THE LEFT STUB. 


163 


104 
165 


DO 143 NR=1,NROWI 


IF (JROW(NR,1).EQ.ITYPE.AND.JROW(NR, 2) .EQ.ISUJB) GO TO 1064 


CONTINUE 

GO TO 105 
TL(NR,NPRIC)=WGHT 
CONTINUE 

RETURN 


END 


SUBROUTINE CINDX 


**kk* SUBROUTINE CINDX COMPUTES THE RELATIVE COST COEFFICIENTS FOR EACH 
*xX* VARIABLE IN THE CURRENT TABLEAU(THE TI( 


> 


) ARRAY) AND THE 


*k*k OBJECTIVE FUNCTION VALUE(THE TA(.) ARRAY) AT THE CURRENT 
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C 
C 


OCP A ae F2-O 


a 


aaa 


Oooo 


*x*x*kk PRIORITY (NPRIC) 


COMMON TT (10,125) ,TB(6@) ,TE(6@, 125) ,TL(6@, 1¢) ,TA(1@) , TI (10,125) ,JC 
10L(125, 2) ,NCOLI, NROWI ,NPRIC,NC(10) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 


kkk COMPUTE TA(NPRIC) AND TI(NPRIC,NC) NC=1,....,NCOLI 


TA(NPRIC)=@. 
DO 1@1 NR=1,NROWL 
1@1 TA(NPRIC)=TA(NPRIC)+TB(NR)*TL(NR,NPRIC) 
DO 162 NCR=1,NCOLI 
TI(NPRIC,NCR)=TT (NPRIC,NCR) 
DO 162 NR=1,NROWI 
1@2 TI(NPRIC,NCR)=TI(NPRIC,NCR)—-TE(NR,NCR)*TL(NR,NPRIC) 
RETURN 


END 


SUBROUTINE TEST (NEVC,NDVR) 


**k** SUBROUTINE TEST DETERMINES THE NEXT ENTERING VARIABLE'S COLUMN 
**** (NEVC) AND THE NEXT DEPARTING VARIABLE'S ROW(NDVR). IF NO 

*xkk* FURTHER OPTIMIZATION IS POSSIBLE, THE VALUE NEVC=@ IS RETURNED. 
*xkkk TF NDVR=@ IS RETURNED, NO MINIMUM POSITIVE RATIO COULD BE FOUND 
*kX* IN THE CURRENT PIVOT OPERATION,I.E., ALL OF THE COEFFICIENTS 
kAKK TE( . ,NEVC) ARE NONPOSITIVE. 


COMMON TT (10,125), TB(6@) ,TE(60,125) ,TL(60,10) ,TA(1@) , TI (14,125) ,JC 
10L (125, 2) ,NCOLI,NROWI ,NPRIC,NC(10) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 
NDVR=@ 

NEVC=@ 

VEVC=¢@. 

VDVR=10. @E+26 


*kk* DETERMINE ENTERING VARIABLE'S COLUMN. 


DO 1@1 NCR=1,NCOLI 
IF (TI(NPRIC,NCR).GE.@.) GO TO 11 
IF (IND(NCR) .EQ.@) GO TO 141 
IF (TI(NPRIC,NCR).GE.VEVC) GO TO 1@1 
NEVC=NCR 
VEVC=TI (NPRIC,NCR) 
161 CONTINUE 


kkk TF NEVC=@, SUBPROBLEM NPRIC IS OPTIMIZED. RETURN. 
IF (NEVC.EQ.@) RETURN 
*k** DETERMINE DEPARTING VARIABLE'S ROW. 


DO 105 NR=1,NROWI 
IF (TE(NR,NEVC).LE.@.) GO TO 15 
V=TB (NR) /TE(NR,NEVC) 
IF (NDVR.EQ.@) GO TO 104 
IF (V-VDVR) 164,192,105 
162 DO 143 NP=1,NPRIC 
IF (TL(NR,NP)-TL(NDVR,NP)) 105,103,104 
163 CONTINUE 
104 VDVR=V 
NDVR=NR 
195 CONTINUE 
RETURN 


END 


SUBROUTINE PERM (NEVC,NDVR) 


x*k* SUBROUTINE PERM PERFORMS THE PIVOT OPERATION USING THE PIVOT 
xk ELEMENT IN COLUMN NEVC AND ROW NDVR AND COMPUTES THE NEW TABLEAU. 


COMMON TT(10,125),TB(6@) , TE(6@, 125) ,TL(60,1@),TA(10), TI (16,125) ,JC 
10L (125, 2) ,NCOLI,NROWI,NPRIC,NC(1@) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 
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OOaa 


cp} 


ana 


aAaAaAND 


xk REPLACE HEADING FOR ROW NDVR. 


JROW (NDVR, 1)=JCOL(NEVC, 1) 
JROW(NDVR, 2)=JCOL(NEVC, 2) 


xx*AX REPLACE TL VECTOR FOR ROW NDVR 


DO 101 NP=1,NPRIC 
1@1 TLCNDVR,NP)=TT (NP ,NEVC) 


xkk* COMPUTE NEW TE ARRAY. 


PIV=TE (NDVR, NEVC) 
PLB=TB (NDVR) 
DO 103 NR=1,NROWI 
IF (NR.EQ.NDVR) GO TO 193 
IF (ABS(TE(NR,NEVC)).LE.@.0005) GO TO 163 
PIX=TE(NR,NEVC) /PIV 
TB(NR)=FIX(TB(NR)-PIX*PIB) 
DO 162 NCR=1,NCOLI 
162 TE (NR,NCR)=FIX(TE(NR,NCR)-TE (NDVR,NCR) *PLX) 
193 CONTINUE 
TB(NDVR)=FIX(PIB/PIV) 
DO 1064 NCR=1,NCOLI 
104 TE(NDVR,NCR)=FIX(TE(NDVR,NCR) /PIV) 
RETURN 


END 


FUNCTION FIX(Z) 


*xx** FUNCTION FIX BRINGS FLOATING POINT VALUES THAT ARE WITHIN 1.E-3 


**k*k* OF AN INTEGER TO THAT INTEGER. 
FIX=AINT (Z+SIGN(.5,Z)) 
IF (ABS (FIX-Z).GT. 1.E-3) FIX=Z 
RETURN 


END 


SUBROUTINE POUT 


*kk* SUBROUTINE POUT PREPARES AND PRINTS THE SOLUTION INFORMATION. 


COMMON TT(16,125),TB(606) , TE(6@, 125) ,TL(60, 10) , TA(1@) , TI (14,125) , JC 
10L(125, 2) ,NCOLI,NROWI ,NPRIC,NC(1@) , JROW(6@, 2) ,NVAR,NPRIT, IND(125) 


COMMON /CHNG/ NCON(6@,10) ,NTOF(10) 

DIMENSION WOUT(125,4), RLHS(60,10), WM(6@), WP (60) 
DIMENSION DIFF(6@) 

WRITE (6,122) 

WRITE (6,123) NPRIC,NROWL 


**x** QUTPUT ARRAY IS ZEROED. 


DO 1@1 T=1,125 
DO 161 J=1,4 
1@1 WOUT(I,J)=@. 


*#kk*X QUTPUT ARRAY IS FILLED. 


DO 102 NP=1,NPRIC 
102 WOUT(NP,1)=FIX(TA(NP)) 
DO 1463 NR=1,NROWL 
L1=JROW(NR, 1) 
L2=JROW (NR, 2) 
1@3 WOUT(12,11)=FIX(TB(NR)) 


xxkK TF ALL PRIORITIES HAVE BEEN INCLUDED, PRINT OPTIMAL SOLUTION. 


*kk* LF NOT, WE MUST CALCULATE VALUES FOR REMAINING TA'S AND D- AND D+ 


[F (NPRIC.GE.NPRIT) GO TO 114 
NP1=NPRIC+1 
DO 113 NP=NP1,NPRIT 
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C 


C **** READ IN THE GOAL CONSTRAINTS ASSIGNED TO PRIORITY NP. 


C 


Cot 3 


OO 


O 


TA(NP)=@. 


IF 


(NC (NP) .EQ.@) GO TO 106 


NCTMP=NC (NP) 


DO 


104 


165 NCI=1,NCTMP 

NR=NROWI+NCL 

READ (5,124) TB(NR), (TE(NR,NV) ,NV=1,NVAR) 

RLHS (NCI,NP)=@. 

DO 104 NV=1,NVAR 

RLHS (NCL,NP)=RLHS (NCL, NP)+TE (NR, NV) *WOUT (NV, 2) 
DIFF (NCL)=TB(NR)-RLHS (NCI ,NP) 


165 CONTINUE 


kk*KKE READ 


THE OBJECTIVE FUNCTION TERMS FOR PRIORITY NP. 


106 NTTMP=NTOF (NP) 


DO 


107 


168 
169 


11¢ 
lil 


112 NT=1,NTTMP 
READ (5,125) ISUB,ITYPE,WGHT 
IF (NC(NP).EQ.@) GO TO 111 
NCTMP=NC (NP) 
DO 11@ NCI=1,NCTMP 
IF (ISUB.NE.NCON(NCI,NP)) GO TO 110 
IF (DIFF(NCI)) 167,108,109 
IF (ITYPE.NE.3) GO TO 11¢ 
WOUT (LSUB, 3)=-DIFF (NCI) 
GO TO 110 
IF (ITYPE.NE.4) GO TO 11¢ 
WOUT (ISUB, 4) =DIFF (NCI) 
CONTINUE 
TA(NP )=TA (NP )+WGHT*WOUT (LSUB, ITYPE) 


112 CONTINUE 
NROWI=NROWI-+NC (NP) 


wee FILL 


IN THE OUTPUT VALUE FOR ATTAINMENT OF PRIORITY NP. 


WOUT(NP,1)=FIX(TA(NP)) 
113 CONTINUE 


xAKK PRINT OPTIMAL SOLUTION 


114 WRITE 
WRITE 


(6,126) 
(6,127) 


DO 115 NV=1,NVAR 
WRITE (6,128) NV,WOUT(NV, 2) 
115 CONTINUE 


WRITE 
WRITE 


(6,126) 
(6,129) 


DO 116 NP=1,NPRIT 


IF 


(NC(NP).EQ.@) GO TO 116 


NCTMP=NC (NP) 
DO 139 NCO=1,NCTMP 
N=NCON (NCO,NP) 
WRITE (6,130) NP,N,WOUT(N, 3) ,WOUT(N, 4) 
139 CONTINUE 
116 CONTINUE 


WRITE 
WRITE 


(6,126) 
(6,131) 


DO 117 NP=1,NPRIT 
WRITE (6,132) NP,WOUT(NP, 1) 
117 CONTINUE 


WRITE 
WRITE 
WRITE 


(6,126) 
(6,133) 
(6,134) 


I=MAX@ (NPRIT,NVAR, NROWL) 
DO 121 K=1,I 


IF (K.GI.NPRIT) GO TO 119 
IF (K.GT.NVAR) GO TO 118 
WRITE (6,135) K, (WOUT(K,J),J=1,4) 
GO TO 121 
118 WRITE (6,136) K,WOUT(K,1), (WOUT(K,J) ,J=3, 4) 
GO TO 121 
119 IF (K.GT.NVAR) GO TO 126 
WRITE (6,137) K, (WOUT(K,J),J=2, 4) 
GO TO 121 
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12@ WRITE (6,138) K, (WOUT(K,J) ,J=3,4) J 1026 

121 CONTINUE J 163¢ 

WRITE (6,126) J 104¢ 

RETURN J 165 

C J 106¢ 

122 FORMAT (1H1) J 1070 
123 FORMAT (/ 39H THE OPTIMIZATION ENDED ON SUBPROBLEM ,I5 / 13H T 

LHERE WERE ,15, 42H CONSTRAINTS IN THE FINAL OPTIMAL TABLEAU.) J 199¢ 
124 FORMAT (8F10.@) J 110¢ 
125 FORMAT (215,F10.@) J 111¢@ 
126 FORMAT (//120(1H*)) J 1120 
127 FORMAT (1H@, 52HTHE OPTIMAL SOLUTION FOR THE DECISION VARIABLES X( J 113@ 

1J)) J 1140 
128 FORMAT (1H@, 2HX(,13, 2H)=,F15.4) J 115@ 
129 FORMAT (1H@, 25HTHE GOAL ACHIEVEMENTS ARE // 9H PRIORITY,2X, 11H 

1GOAL NUMBER, 2X, 16HOVER-ACHIEVEMENT, 2X, 17HUNDER-ACHIEVEMENT) J 1179 
13@ FORMAT (4X,12,10X,12,10X,F1@.4, 1@X,F10. 4) J 118@ 
131 FORMAT (1H@, 29HTHE PRIORITY ACHIEVEMENTS ARE // 9H PRIORITY, 8X, 

1 11HACHIEVEMENT) J 126¢ 
132 FORMAT (4X,12,106X,F1@.4) J 121¢ 
133 FORMAT (LH@, 15H OUTPUT SUMMARY) J 1220 
134 FORMAT (1H@, 9Q9HSUBSCRIPT,11X, 8H A OPT,7X, 8H xX OPT,7X, 9H J 123 

1 POS DEV,6X, 9H NEG DEV /) 

135 FORMAT (18, 7X,4F15.4) J 1250 
136 FORMAT (18,7X,F15.4, 15X, 2F15. 4) J 126@ 
137 FORMAT (18,22X, 3F15.4) J 1270 
L138 FORMAT (18,37X,2F15.4) J 1280 

C J 129¢ 
END J 130¢ 
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ALGORITHM 558 


A Program for the Multifacility Location 
Problem with Rectilinear Distance 
by the Minimum-Cut Approach [H] 


TO-YAT CHEUNG 
University of Ottawa 


Key Words and Phrases: multifacility, optimal location, rectilinear distance, minimum cut 
CR Categories: 3.57, 5.41 
Language: Fortran 


DESCRIPTION 


This algorithm complements [1], where more details are given. The coding of the 
algorithm consists of two subroutines, LOCATE and NETFLO. A user’s program 
calls LOCATE, which contains the major coding, and calls NETFLO for solving 
the minimum-cut network flow subproblems. 
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ALGORITHM 

é TP1 00060 
C *TEST PROGRAM #1* (DATA INPUT FROM CARDS) TP1 66061 
C THIS IS THE FIRST OF TWO PROGRAMS FOR THE TESTING OF THE TP1 6062 
C SUBROUTINE 'LOCATE'. ALL IT DOES IS TO READ THE DATA NVPT, TP1 60663 
C NFPT, VWT AND VFWT FROM CARDS, CALL 'LOCATE', AND PRINT THE TP1l A004 
C SOLUTION POST. TP1l 0005 
C IT FIRST READS AN INTEGER NPRLM FROM A CARD, USING TP1 00066 
C FORMAT(13), WHERE NPRLM IS THE NUMBER OF PROBLEMS TO BE TP1 00067 
C TESTED IN A SINGLE RUN. THEN, FOR EACH PROBLEM TESTED, TP1 0008 
C A SET OF 1+2*NVPT DATA CARDS WILL BE READ. THE FORMAT TP1 6009 
C AND SETUP OF THESE CARDS SHOULD BE CLEAR FROM THE READ TP1 0010 
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STATEMANTS AT STATEMENT LABEL 2, IN LOOP 7 AND LOOP 10. 
INTEGER VWT(3@, 30) , VFWT (30, 60) , POST (30) 
FOR EXPLANATION OF THESE VECTORS, SEE SUBROUTINE 'LOCATE'. 


READ(5,1) NPRLM 
1 FORMAT (13) 
NP=1 
2 READ(5,3) NVPT,NFPT 
3 FORMAT (213) 
WRITE(6,4) NP,NVPT,NFPT 
4 FORMAT(1H1/////14H TEST PROBLEM ,13//11H NUMBER OF , 
LLOHVARIABLE POINTS IS ,13,24H; NUMBER OF FIXED POI, 
17HNTS IS ,12) 
WRITE (6,5) 
5 FORMAT (2@H@WEIGHT MATRIX VWT :/) 
DO 7 I=1,NVPT 
READ(5,6) (VWI(1,J),J=1,NVPT) 
6 FORMAT (2513) 
7 WRITE(6,8) (VWI(I,J),J=1,NVPT) 
8 FORMAT (5X, 22(13,1X)/13X, 20(13,1X)/13X, 20(13,1X)) 
WRITE (6,9) 
9 FORMAT (21H@WEIGHT MATRIX VFWT :/) 
DO 1@ I=1,NVPT 
READ(5,6) (VFWT(1,J),J=1,NFPT) 
16 WRITE(6,8) (VFWT(1,J) ,J=1,NFPT) 
CALL LOCATE (NVPT,NFPT,VWT,VFWT, POST) 
WRITE(6,11) (POST(I),I=1,NVPT) 
11 FORMAT(38H-OPTIMAL LOCATIONS OF VARIABLE POINTS , 
142HCOINCIDE WITH THE FOLLOWING FIXED POINTS ://3X, 
122(13,1X)/3X, 20(13,1X)) 


CHECK WHETHER THERE IS MORE TEST PROBLEM 
NP=NP+1 
IF(NP.LE.NPRLM) GO TO 2 
STOP 
END 


*TEST PROGRAM #2* (DATA GENERATED RANDOMLY) 

THIS IS THE SECOND OF THE TWO MAIN PROGRAMS FOR TESTING 
THE SUBROUTINE 'LOCATE'. IT TESTS DATA GENERATED RANDOMLY 
BY A SUBROUTINE CALLED RANDU. IT FIRST READS AN INTEGER 
NPRLM FROM A CARD, USING FORMAT(13), WHERE NPRLM IS THE 
NUMBER OF PROBLEMS TO BE TESTED IN A SINGLE RUN. FOR EACH 
PROBLEM TESTED, THE USER PROVIDES ONLY A SINGLE CAR) TO BE 
READ BY THE FOLLOWING STATEMENTS: 


2 READ(5, 3)NVPT,NFPT,NCHECK , MVWT ,MVFWT, RANGE 
3 FORMAT (513, F6.2) 


WHERE 

NVPT - NUMBER OF VARIABLE POINTS. 

NFPT - NUMBER OF FIXED POINTS. 

NCHECK - NUMBER OF SETS OF VARIABLE-POINT LOCATIONS 
GENERATED FOR CHECKING THE OPTIMALITY OF THE 
OBTAINED SOLUTION. 

MVWT - UPPER BOUND ON THE WEIGHTS (F10@@) BETWEEN THE 
VARIABLE POINTS. 

MVFWT - UPPER BOUND ON THE WEIGHTS (F1@@@) BETWEEN THE 
FIXED AND VARIABLE POINTS. 

RANGE - UPPER BOUND ON THE RANGE OF LOCATIONS GENERATED. 


USING THESE INPUT DATA, THIS PROGRAM FIRST RANDOMLY GENERATES 


A SET OF FIXED-POINTS LOCATIONS. IT THEN GENERATES RANDOMLY 
NCHECK SETS OF VARIABLE-POINT LOCATIONS AND COMPARES THEM 
WITH THE OPTIMAL LOCATIONS OBTAINED BY 'LOCATE'. 

THIS MAIN PROGRAM INCLUDES THREE OTHER SUBROUTINES: 

RANDU, CHECK AND SUM. 


INTEGER VWT(3@, 30) , VFWT (30, 60) , POST (3@) 


TPL 
TPl 
TPL 
TPL 
TPL 
TPL 
TPL 
TPL 
TPl 
TPL 
TPL 
TPL 
TPL 
TPL 
TPL 
TPL 
TPl 
TPL 
TPL 
TP1 
TPL 
TPL 
TPL 
TPL 
TPL 
TP1 
TP1 
TP1 
TP1 
TP1 
TP1l 
TPL 
TPL 
TPL 
TPL 
TPL 
TPL 
TPL 


TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 


POLL 
0012 
0013 
0014 
OO15 
0016 
0017 
0018 
0019 
0026 
QO21 
0022 
0023 
0024 
0025 
0026 
0027 
09028 
0629 
0030 
$031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
6643 
0044 
0045 
0046 
0047 
0048 


0000 
$001 
0002 
9003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
POLL 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
$021 
0h22 
0023 
0624 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
$0632 
0033 
60634 
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Cc TP2 6035 
C FOR EXPLANATION OF THESE VECTORS, SEE SUBRQUTINE 'LOCATE' TP2 $036 
Cc TP2 0637 
READ(5,1) NPRLM TP2 $038 

1 FORMAT (13) TP2 0639 
LY=2*NPRLM+1 TP2 0640 

NP=1 TP2 0041 

2 READ(5,3) NVPT,NFPT,NCHECK,MVWT,MVFWT, RANGE TP2 0042 

3 FORMAT (513, F6. 2) TP2 0643 
WRITE(6,4) NP,NVPT,NFPT TP2 0044 

4 FORMAT(1H1/////14H TEST PROBLEM ,13//11H NUMBER OF , TP2 0045 
119HVARIABLE POINTS IS ,13,24H; NUMBER OF FIXED POI, TP2 $046 
17HNTS IS ,12) TP2 0047 
WRITE(6,5) MVWT TP2 6048 

5 FORMAT (35H@WELGHT MATRIX VWT (UPPER BOUND IS ,13,2H):/) TP2 0049 

C TP2 0656 
C GENERATE MATRIX VWT CONTAINING WEIGHTS BETWEEN VARIABLE TP2 O@51 
C POINTS. TP2 0052 
DO 9 I=1,NVPT TP2 0053 

DO 6 J=I,NVPT TP2 0054 

IX=LY TP2 $055 

CALL RANDU(ILX,1Y,YFL) TP2 0056 
TEMP=FLOAT (MVWT) *YFL TP2 0057 

VWT (L,J)=INT (TEMP) TP2 6658 
VWI(J,1)=VWT(1,J) TP2 0659 

IF (1.EQ.J) VWI(1,J)=@ TP2 0060 

6 CONTINUE TP2 00661 
WRITE(6,7) (VWI(1,J),J=1,NVPT) TP2 0062 

7 FORMAT (5X, 22(13,1X)/13X, 26(13, 1X) /13X, 26(13, 1X)) TP2 0663 

Cc TP2 6064 
C GENERATE MATRIX VFWI CONTAINING WEIGHTS BETWEEN VARIABLE AND TP2 6065 
C FIXED POINTS. TP2 6066 
DO 8 J=1,NFPT TP2 0067 

LX=LY TP2 0668 

CALL RANDU(IX,IY,YFL) TP2 $669 
TEMP=FLOAT (MVFWT) *YFL TP2 0670 

VFWT (L,J)=INT (TEMP) TP2 00671 

8 CONTINUE TP2 0072 

9 CONTINUE TP2 6073 
WRITE(6,10) MVFWT TP2 0074 

16 FORMAT (36H@WELGHT MATRIX VFWI (UPPER BOUND IS ,13, TP2 6075 
12H):/) TP2 0076 

DO 11 I=1,NVPT TP2 0677 

11 WRITE(6,7) (VEWI(I,J),J=1,NFPT) TP2 $078 

C . TP2 00679 
C FIND AN OPTIMAL SOLUTION BY CALLING ‘LOCATE’. TP2 0086 
CALL LOCATE (NVPT,NFPT, VWT, VFWT, POST) TP2 0081 
WRITE(6,12) (POST(I),I=1,NVPT) TP2 0082 

12 FORMAT (38H-OPTIMAL LOCATIONS OF VARIABLE POINTS , TP2 $683 
142HCOINCIDE WITH THE FOLLOWING FIXED POINTS ://3X, TP2 0684 
122(13, 1X) /3X, 2@(13, 1X)) TP2 0085 

C TP2 0086 
C TO TEST THE OPTIMALTY OF THE SOLUTION OBTAINED BY ‘LOCATE’, TP2 0087 
C THE SUBROUTINE CHECK GENERATES NCHECK SETS OF VARIABLE- TP2 6688 
C POINT LOCATIONS IN THE RANGE (@,RANGE) FOR COMPARISON. TP2 0089 
CALL CHECK (NVPT,NFPT, VWT, VFWT,POST,NCHECK, RANGE) TP2 $090 
NP=NP+1 TP2 6091 
IF(NP.LE.NPRLM) GO TO 2 TP2 0092 

STOP TP2 $093 

END TP2 9094 
SUBROUTINE RANDU(IX,IY,YFL) TP2 0095 

Cc TP2 0696 
C THIS GENERATOR GENERATES A NUMBER RANDOMLY AND UNIFORMLY TP2 0097 
C IN (6,1). SEE MACLAREN AND MARSALIA, J. ACM, VOL. 12, TP2 6098 
C PP.83-89, AND IBM SCIENTIFIC SUBROUTINE PACKAGE. TP2 0099 
Cc TP2 91060 
LY=1X*65539 TP2 O161 

IF (TY) 1,2,2 TP2 0102 

L IY=IY+2147483647+1 TP2 $103 

2 YFL=LY TP2 0104 
YFL=YFL*@. 4656613E-9 TP2 0105 
RETURN TP2 0106 


END TP2 6167 
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SUBROUTINE CHECK (NVPT,NFPT, VWT, VFWT, POST ,NCHECK , RANGE) TP2 0168 

C TP2 $169 
C THIS SUBROUTINE FIRST RANDOMLY GENERATES A SET OF FIXED- TP2 0110 
C POINT LOCATIONS. IT THEN GENERATES RANDOMLY NCHECK SETS OF TP2 @111 
C VARIABLE-POINT LOCATIONS AND COMPARES THEM WITH THE TP2 0112 
C OPTIMAL LOCATIONS OBTAINED BY THE ALGORITHM. TP2 0113 
C TP2 0114 
INTEGER VWT(3@,1),VFWT(3@,1),POST(1) TP2 115 
DIMENSION VPLOC (3) , FPLOC (60) TP2 $116 

C TP2 $117 
C VPLOC — VARIABLE-POINT LOCATIONS. TP2 $118 
C FPLOC - FIXED-POINT LOCATIONS. TP2 $119 
C THE MEANINGS OF THE OTHER VARIABLES ARE GIVEN IN THE TEST TP2 $120 
C PROGRAM #2. TP2 $121 
C TP2 122 
C GENERATE FIXED-POINT LOCATIONS. TP2 $123 
C TP2 6124 
IY=NCHECK*2+1 TP2 0125 

FPLOC (1)=@. TP2 $126 

DO 1 I=2,NFPT TP2 $127 

LX=I1Y TP2 $128 

CALL RANDU(IX,IY,YFL) TP2 $129 

FPLOC (L)=Y FL*RANGE TP2 013 

lL CONTINUE TP2 $131 
N1=NFPT-1 TP2 $132 

DO 3 I=2,N1 TP2 0133 
I1=I4+1 TP2 $134 

DO 2 J=I1,NFPT TP2 0135 

LF (FPLOC(1).LE.FPLOC(J)) GO TO 2 TP2 $136 

T=FPLOC (1) TP2 $137 

FPLOC (1)=FPLOC (J) TP2 $138 

FPLOC (J)=T TP2 $139 

2 CONTINUE TP2 G14 

3 CONTINUE TP2 $141 
T=FPLOC (NFPT) TP2 $142 
WRITE(6,4) RANGE,T TP2 $143 

4 FORMAT (1L4H@RANDOM CHECK: //3X,13HFIXED-POINT , TP2 6144 
15@H LOCATIONS ARE GENERATED RANDOMLY IN THE RANGE (@, TP2 6145 
14H.00,,F6.2,1H)/3X, 29HVARIABLE-POINT LOCATIONS ARE , TP2 $146 
138HGENERATED RANDOMLY IN THE RANGE (@.6@,,F6.2,1H)// TP2 6147 

14X, 26HFIXED-POINT LOCATIONS ARE: ) TP2 $148 
WRITE(6,5) (FPLOC(1),I=1,NFPT) TP2 $149 

5 FORMAT (7X, 12F7.2) TP2 0150 

Cc TP2 @151 
C GENERATE VARIABLE-POINT LOCATIONS AND EVALUATE THE TP2 O152 
C WEIGHTED SUM OF DISTANCES. TP2 $153 
DO 6 I=1,NVPT TP2 $154 
J=POST(1) TP2 $155 

VPLOC (L)=FPLOC (J) TP2 $156 

6 CONTINUE TP2 0157 
WRITE (6, 7) TP2 $158 

7 FORMAT (42H@ OPTIMAL VARIABLE-POINT LOCATIONS ARE:) TP2 0159 
WRITE(6,5) (VPLOC(I),1=1,NVPT) TP2 916 
S=SUM(NVPT,NFPT, VWT, VFWT, VPLOC, FPLOC) TP2 $161 
WRITE(6,8) S TP2 $162 

8 FORMAT (8X, 29HWEIGHTED SUM OF DISTANCES IS:,3X,E11.3) TP2 0163 

DO 11 I=1,NCHECK TP2 $164 

DO 9 J=1,NVPT TP2 $165 

LX=1LY TP2 $166 

CALL RANDU(IX, LY,YFL) TP2 $167 

VPLOC (J)=YFL*T TP2 9168 

9 CONTINUE TP2 $169 
WRITE(6,1@) I TP2 $17¢ 

1@  FORMAT(15H@ CHECK #(,13,2H):,5X, LIHVARIABLE-PO, TP2 $171 

1 18HINT LOCATIONS ARE:) TP2 $172 
WRITE(6,5) (VPLOC(J),J=1,NVPT) TP2 06173 
S=SUM(NVPT ,NFPT, VWT, VFWT, VPLOC, FPLOC) TP2 0174 
WRITE(6,8) S TP2 $175 

11 CONTINUE TP2 $176 
RETURN TP2 $177 

END TP2 $178 
FUNCTION SUM(NVPT,NFPT, VWT, VFWT,VPLOC, FPLOC) TP2 6179 

Cc TP2 0180 


C THIS SUBROUTINE CALCULATES THE WEIGHTED SUM OF DISTANCES TP2 $181 
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BETWEEN ALL THE VARIABLE POINTS AND FIXED POINTS. 
THE MEANINGS OF THE INPUT PARAMETERS ARE EXPLAINED IN THE 
SUBROUTINE 'CHECK' AND TEST PROGRAM #2. 


INTEGER VWT(30, 1) ,VFWT (30, 1) 
DIMENSION VPLOC(1) ,FPLOC(1) 
SUM=0. 
DO 3 I=1,NVPT 
pO 1 J=1,1 
IF (I1.NE.J) SUM=SUM+FLOAT(VWT(I,J)) 
1 *ABS (VPLOC (L)-VPLOC(J)) 
1 CONTINUE 
DO 2 J=1,NFPT 
SUM=SUM+FLOAT (VFWT (I,J) )*ABS (VPLOC(1)-FPLOC(J)) 
2 CONTINUE 
3 CONTINUE 
RETURN 
END 


SUBROUTINE LOCATE (NVPT,NFPT, VWT, VFWT, POST) 


THIS SUBROUTINE SOLVES THE FOLLOWING ONE-DIMENSIONAL 
MULTIFACILITY LOCATION PROBLEM USING AN ALGORITHM DESIGNED 
BY PICARD, RATLIFF (SEE OPERATIONS RESEARCH 26 (1978), 
PP.422-433) AND CHEUNG. 
" GIVEN NFPT FIXED POINTS ON A LINE, DETERMINE THE 

LOCATIONS OF NVPT VARIABLE POINTS SUCH THAT A WEIGHTED 

SUM OF THE DISTANCES BETWEEN THE POINTS IS MINIMUM." 
OUR ALGORITHM TRANSFORMS THE LOCATION PROBLEM TO A SEQUENCE 
OF MINIMUM-CUT PROBLEMS. A FORTRAN CODE (THE SUBROUTINE 
NETFLO IN "COMBINATORIAL ALGORITHMS", WRITTEN BY NIJENHUIS 
AND WILF) OF DINIC'S ALGORITHM IS USED TO FIND THE MINIMUM 
CUTS. ; 
TO APPLY THE SUBROUTINE 'LOCATE', THE FIXED POINTS SHOULD 
BE SUBSCRIPTED ON THE LINE IN INCREASING ORDER OF THEIR 
LOCATIONS. THEIR EXACT LOCATIONS ARE NOT REQUIRED. 


INTEGER COL,SOURCE,SUM 
INTEGER POST(1) ,CVPT (32) ,CUT(32) ,ENDPT (4, 93@) 
INTEGER VWT (3@, 1) , VFWT (30, 1) 


ON INPUT 
NVPT NUMBER OF VARIABLE POINTS. 
NFPT NUMBER OF FIXED POINTS. 
VWT A SQUARE MATRIX WHOSE UPPER TRIANGULAR PART 


CONTAINS THE WEIGHTS BETWEEN THE VARIABLE POINTS. 


THE WEIGHTS MUST BE NON-NEGATIVE INTEGERS. 

VEWT WEIGHTS BETWEEN THE VARIABLE AND FIXED POINTS. 

THE WEIGHTS MUST BE NON-NEGATIVE INTEGERS. 
ON OUTPUT 

POST A VECTOR INDICATING THE OPTIMAL LOCATIONS OF THE 
VARIABLE POINTS. VARIABLE POINT I WILL COINCIDE 
WITH THE FIXED POINT WHOSE POSITION IS POST(I). 

FOR WORKING STORAGE 
(IN THE FOLLOWING, MNVP MEANS 'THE MAXIMUM NUMBER OF 
VARIABLE POINTS'.) 

CVPT A VECTOR OF LENGTH MNVP+2, IT REPRESENTS THE 
VARIABLE POINTS WHICH PARTICIPATE IN THE CURRENT 
ITERATION. THE VARIABLE POINT CVPT(I) IS THE 
NODE I OF THE CURRENT NETWORK. 

ENDPT A MATRIX OF DIMENSION 4 X E, WHERE E=MNVP* 

* (MNVP-+1). EACH ARC CORRESPONDS TO A COLUMN OF 
ENDPT, WHOSE 4 ROWS DENOTE THE INITIAL VERTEX, 
THE TERMINAL VERTEX, THE CAPACITY AND MAXIMUM 
FLOW OF THAT ARC RESPECTIVELY. 

CUT A VECTOR OF LENGTH MNVP+2. FOR A MIN-CUT, 
CUT(I)=1 MEANS NODE I IS ASSOCIATED WITH THE 
SOURCE, AND CUT(I)=@ MEANS NODE I IS ASSOCIATED 
WITH THE SINK. 


IF (NVPT.EQ.1) GO TO 13 
INITIALIZE ENDPT FOR THE FIRST ITERATION. 


SOURCE=NVPT+1 
COL=@ 


TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 
TP2 


LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
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LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
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LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 


0182 
$183 
0184 
0185 
0186 
0187 
0188 
0189 
0190 
191 
0192 
0193 
194 
0195 
0196 
0197 
0198 
9199 


0000 
0001 
OOG2 
0003 
DOOS 
0005 
0006 
0007 
0008 
0009 
0016 
0911 
$012 
0013 
0014 
0@15 
0016 
0017 
$018 
$019 
0020 
0021 
0922 
$023 
0024 
0025 
0026 
0027 
$028 
$629 
$030 
$031 
0032 
$033 
$034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
HO43 
O44 
AO45 
AA46 
A047 
A048 
0049 
APSO 
0051 
HO52 
0053 
0054 
0055 
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DO 6 1=1,NVPT LOC 6056 
CVPT(1)=1 LOC $057 

POST (L)=6 LOC 90658 

DO 5 J=1,NVPT LOC 0@59 
COL=COL+1 LOC 006 
ENDPT(1,COL)=I LOC $661 

ENDPT (2,COL)=J LOC 0062 

ENDPT (4, COL)=@ LOC 0063 

IF (I-J) 1,2,4 LOC 0064 

1 ENDPT (3, COL)=VWT(1,J) LOC $065 

GO TO 5 LOC 9066 

2 ENDPT (1, COL) =SOURCE LOC 0067 
SUM=@ LOC $68: 

DO 3 K=1,NFPT LOC 0069 
SUM=SUM+VFWT (I,K) LOC $070 

3 CONTINUE LOC 0071 
ENDPT (3, COL)=SUM LOC $072 

GO TO 5 LOC 0073 

4 ENDPT (3,COL)=VWT(J,I) LOC 0074 

5 CONTINUE LOC 00675 

6 CONTINUE LOC $076 
NN=NVPT LOC 0077 

C LOC 0078 
C ITERATIONS LOC $079 
DO 12 ITER=1,NFPT LOC 6080 
NNODE=NN+2 LOC 0081 

DO 7 I=1,NN LOC $082 
COL=COL+1 LOC $083 

ENDPT (1,COL)=I LOC 0084 

ENDPT (2, COL) =NNODE LOC 00685 

L=CVPT (1) LOC $@86 

ENDPT (3,COL)=2*VEWT (L, ITER) LOC 06087 

ENDPT (4, COL) =@ LOC $088 

7 CONTINUE LOC 0089 

Cc LOC $096 
C SOLVE A MIN-CUT PROBLEM BY DINIC'S ALGORITHM. LOC $091 
CALL NETFLO(NNODE,COL,ENDPT, SOURCE ,NNODE, CUT) LOC 0092 

Cc LOC 0693 
C UPDATE POST AND INITIALIZE CVPT FOR THE NEXT ITERATION. LOC 9094 
N2=NN LOC $995 

NN=@ LOC $696 

DO 9 I=1,N2 LOC $097 

IF (CUT(I).EQ.1) GO TO 8 LOC 6698 

L=CVPT (1) LOC $699 

POST (L)=ITER LOC $140 

GO TO 9 LOC $101 

8 NN=NN+1 LOC 6162 
CVPT (NN) =CVPT(L) LOC $163 

9 CONTINUE LOC $104 

C LOC 9105 
C NN IS THE NUMBER OF VARIABLE POINTS IN THE NEXT ITERATION. LOC 9106 
IF (NN.EQ.@) RETURN LOC $107 

Cc LOC $108 
C INITIALIZE ENDPT FOR THE NEXT ITERATION. LOC $169 
SOURCE=NN+1 LOC $11 

COL=@ LOC @111 

LL=@ LOC $112 

pO 11 I+1,N2 LOC $113 
IF(CUT(1).EQ.@) GO TO 11 LOC 6114 

IL=IL+] LOC $115 

JL=0 LOC 0116 

DO 1@ J=1,N2 LOC $117 
[F(CUT(J).EQ.0) GO TO 10 LOC $118 

COL=COL+1 LOC $119 

JL®JL+1 LOC $12 

ENDPT (1, COL)=IL LOC $121 

LF(L.EQ.J) ENDPT(1,COL)=SOURCE LOC $122 

ENDPT (2, COL)=JL LOC $123 

L= (1-1) *N2+J LOC $124 

ENDPT (3, COL)=ENDPT (3, L)-ENDPT(4,L) LOC $125 

ENDPT (4, COL)=0 LOC $126 

1d CONTINUE LOC $127 

11 CONTINUE LOC $128 

12 CONTINUE LOC $129 
RETURN LOC $130 


Cc LOC $131 
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C 


Cc 
C 
C 


AANAAQTAANQRAAARAAAANAA 


 O.e2 CF 83 


C 
C 


IN CASE THE NUMBER OF VARIABLE POINTS IS 1, OUR PROBLEM IS 
THE SAME AS THE 1-MEDIAN LOCATION PROBLEM. OUR ALGORITHM 
IS ALSO EQUIVALENT TO THE FOLLOWING WELL-KNOWN SIMPLE 
PROCESS FOR SOLVING 1-MEDIAN LOCATION PROBLEMS. 
13 SUM=-VFWT(1, 1) 
DO 14 I=2,NFPT 
SUM=SUM+VFWT (1, I) 
14 CONTINUE 
I=1 
15 IF (SUM.LE.@) GO TO 16 
I=I41 
SUM=SUM-VFWT(1,1)*2 
GO TO 15 
16 POST(1)=1 
RETURN 
END 


SUBROUTINE NETFLO(N,E,ENDPT,SOURCE,SINK,CUT) 


THIS SUBROUTINE SOLVES A MAX-FLOW-MIN-CUT PROBLEM USING 
DINIC'S ALGORITHM. THE CODE IS TAKEN FROM ''COMBINATORIAL 
ALGORITHMS", ACADEMIC PRESS, WRITTEN BY A. NIJENHUIS 

AND H.S. WILF. THERE ARE THREE MINOR CHANGES: (1) STATEMENT 
LABELS ARE RENUMBERED. (2) SOME DATA DECLARATION STATEMENTS 
AND THE FORMAL PARAMETER LIST HAVE BEEN MODIFIED. (3) THE 
WAY OF SUBSCRIPT CONSTRUCTION FOR SOME OF THE ARRAYS IS 
MODIFIED. THE MODIFICATIONS ARE MAINLY FOR COMPLIANCE WITH 
ANSI FORTRAN STANDARD. 

THANKS ARE DUE TO THE AUTHORS AND PUBLISHER OF 
"COMBINATORIAL ALGORITHMS' FOR THEIR PERMISSION TO INCLUDE 
THIS SUBROUTINE. 


INTEGER C,E,P,Q,RD,WR, DELTA, SINK, SOURCE, FLOVAL 
INTEGER ENDPT(4,1),CUT(1) 
INTEGER CAP (32, 32), VERT (32, 32) ,AUX(32) 


ENDPT AND CUT ARE EXPLAINED IN THE SUBROUTINE ‘LOCATE’. 
CAP, VERT AND AUX ARE WORKING STORAGE, WHOSE LENGTH IS 
EQUAL TO THE NUMBER OF VARIABLE POINTS PLUS 2. 


INITIALIZATION. 
DO 2 I=1,N 
DO 1 J=1,N 
CAP (1,J)=@ 
1 CONTINUE 
2 CONTINUE 
DO 3 I=1,E 
I1=ENDPT (1, I) 
I12=ENDPT (2,1) 
CAP (I1,12)=ENDPT (3,1) 
3 CONTINUE 
DO 5 I=1,N 
K=@ 
DO 4 J=1,N 
IF (CAP (I,J)+CAP(J,1).EQ.6) GO TO 4 
K=K+1 
VERT(1,K)=J 
4 CONTINUE 
VERT (1,N)=K 
5 CONTINUE 
NMIN=-N-1 
FLOVAL=@ 


SCANNING AND LABELING 
6 LBLSNK=N 
DO 7 I=1,N 
CUT (L)=NMIN 
7 CONTINUE 
RD=@ 
WR=9@ 
P=SOURCE 
LABEL=-1 
8 M=VERT(P,N) 
I=1 
9 IF(I.GT.M) GO TO 13 


LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 
LOC 


NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 
NET 


$132 
$133 
0134 
$135 
0136 
0137 
0138 
$139 
0140 
141 
142 
0143 
0144 
0145 
6146 
$147 


0000 
OOOL 
0002 
$003 
0004 
0005 
0006 
0007 
0008 
9009 
0010 
0611 
0012 
$013 
0014 
0015 
$016 
0017 
0018 
0019 
0026 
0021 
0622 
$023 
0024 
0025 
0626 
$027 
$028 
0929 
0030 
$031 
0032 
0033 
0034 
0035 
0036 
0637 
$038 
0039 
0040 
OO41 
0042 
0043 
0044 
0045 
0046 
0047 
0648 
0049 
0050 
0651 
0052 
$0653 
0054 
0055 
$056 
0657 
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C 


Q=VERT(P,1) 
IF(CAP(P,Q).EQ.@) GO TO 12 
IF(Q.EQ.SINK) LBLSNK=-LABEL 
LF(CUT(Q)-LABEL) 1@,11,12 


1@ CUT (Q)=LABEL 


WR=WRt+1 
AUX (WR) =Q 


11 I=I+1 


12 


GO TO 9 

VERT (P, 1)=VERT (P,M) 
VERT (P,M)=Q 

M=M-1 

GO TO 9 


13 CUT(P)=M 


RD=RD+1 

IF(RD.GT.WR) GO TO 24 

P=AUX (RD) 
IF(CUT(P)+LBLSNK.EQ.@) GO TO 14 
LABEL=CUT (P)-1 

GO TO 8 


C CONSTRUCTION OF PATH FROM SOURCE TO SINK 


C 


14 


15 


Q=SOURCE 

K=@ 

K=K+1 

AUX (K)=Q 

LF(K.GT.LBLSNK) GO TO 19 


16 P=AUX(K) 
17 M=CUT(P) 


18 


19 


LF(M.EQ.@) GO TO 18 

Q=VERT (P,M) 

GO TO 15 

K2K-1 

LF(K.EQ.@) GO TO 6 

P=AUX(K) 

CUT (P)=CUT(P)-1 

COTO" L7 

IF(Q.NE.SINK) GO TO 18 

DELTA=CAP (P,Q) 

DO 20 1=2,K 
11=AUX(I-1) 
12=AUX(1) 
DELTA=MIN@ (DELTA, CAP (I1,12)) 


20 CONTINUE 
21 K=K-1 


22 


IF(K.EQ.@) GO TO 23 
P=AUX (K) 

C=CAP (P,Q)-DELTA 
IF(C.GT.@) GO TO 22 

CUT (P)=CUT(P)-1 

KO=K 

CAP (P,Q)=C 

CAP (Q,P)=CAP (Q,P)+DELTA 
Q=P 

GO TO 21 


23 FLOVAL=FLOVAL+DELTA 


K=KO 
GO TO 16 


C EXIT PROCEDURE. 


= 


wSew oo 


25 


26 


24 DO 25 I=1,N 


CUT (1)=MIN@ (1, CUT (L)-NMIN) 
CONTINUE 
DO 26 I=1,E 

L1=ENDPT (1,1) 

L2=ENDPT (2,1) 

ENDPT (4, 1)=ENDPT (3,1)-CAP (11,12) 
CONTINUE 
RETURN 
END 


Sweet 
Fe fh 


NET $058 
NET $059 
NET 00660 
NET $061 
NET 0062 
NET 0063 
NET (064 
NET $065 
NET 6066 
NET (067 
NET $968 
NET 0969 
NET 0070 
NET 0071 
NET 0072 
NET 0073 
NET 00674 
NET 0075 
NET 0076 
NET 0077 
NET 0078 
NET 00679 
NET $08¢ 
NET 0081 
NET 0082 
NET 0983 
NET 0984 
NET $085 
NET $086 
NET (087 
NET 0088 
NET $089 
NET 0090 
NET 6091 
NET 9092 
NET 0693 
NET 0694 
NET $095 
NET 90696 
NET $697 
NET 00698 
NET 09099 
NET 010¢ 
NET $161 
NET $12 
NET $103 
NET $104 
NET $195 
NET 0106 
NET 0107 
NET $108 
NET $109 
NET $110 
NET $111 
NET $112 
NET $113 
NET $114 
NET $115 
NET $116 
NET 6117 
NET 9118 
NET $119 
NET $120 
NET $121 
NET $122 
NET $123 
NET $124 
NET $125 
NET 0126 
NET $127 
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COLLECTED ALGORITHMS FROM ACM 


ALGORITHM 559 
The Stationary Point of a Quadratic 
Function Subject to Linear Constraints [E4] 


J. T. BETTS 
The Aerospace Corporation 


Key Words and Phrases: quadratic programming, orthogonal decomposition 
CR Categories: 5.14, 5.15, 5.4, 5.40, 5.41 
Language: Fortran 


DESCRIPTION 
This algorithm implements the method developed in [1]. 


REFERENCE 


1, Betts, J.T. A compact algorithm for computing the stationary point of a quadratic function 
subject to linear constraints. ACM Trans. Math. Softw. 6, 3 (Sept. 1980), 391-397. 


ALGORITHM 

C PROGRAM DRIVER (INPUT, OUTPUT, TAPE5=INPUT, TAPE6=OUTPUT) 
DIMENSION A(4,4), B(4), C(4,4), D(4), G(4), H(4), UC(4), IP(4), 
* X(4) 


DIMENSION DJNORM(1) 

DIMENSION DMCX(4), AA(4,4), BB(4), CC(4,4), DD(4) 
DIMENSION NN(12), MM(12), KEYKEY(12) 

DATA NN /0,1,1,3,3,3,3,3,4,4,4, 4/ 

DATA MM /0,9,1,0,1,2,3,4,9, 3,0, 2/ 

DATA KEYKEY /1,1,1,1,1,1,1,1,2,2, 3, 3/ 

DATA MAXRA, MAXRC, MAXCAS /4,4,12/ 

DATA TAU /1.E~-12/ 


THE PURPOSE OF THIS DRIVER IS TO DEMONSTRATE THE USE OF 
SUBROUTINE HSQP 


TEST CASES ARE SPECIFIED BY THE CONTENTS OF THE 
ARRAYS NN(), MM(), AND KEYRKEY(). 
KEY = 1 SETS A AND C NONSINGULAR. 
2 SETS RANK OF A = MIN( N, 2) 
AND RANK OF C = MIN( M, N, 2) 
3 SETS C NONSINGULAR AND ALL ELTS OF A = @. 


It 


SET TAU TO ABOUT 160 TIMES THE MACHINE PRECISION. 


OGAOaAroaAaeaaoea 


DO 236 KASE=1,MAXCAS 
N = NN(KASE) 

M = MM(KASE) 

KEY = KEYKEY (KASE) 


Received 23 September 1977; revised 30 July 1979; accepted 11 December 1979. 

Permission to copy without fee all or part of this material is granted provided that the copies are not 
made or distributed for direct commercial advantage, the ACM copyright notice and the title of the 
publication and its date appear, and notice is given that copying is by permission of the Association 
for Computing Machinery. To copy otherwise, or to republish, requires a fee and/or specific 
permission. 

Author’s address: The Aerospace Corporation, P.O. Box 92957, Los Angeles, CA 90009. 
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WRITE (6,101) KASE, N, M, KEY, TAU 


aa 


DEFINE OBJECTIVE FUNCTION 


ol 


LF (N.LE.@) GO TO 16@ 
DO 6@ I=1,N 
B(L) = FLOAT(L) - .@5 * FLOAT(1)**2 
BB(L) = B(1) 
DO 5@ J=1I,N 
GO TO (16, 26, 30), KEY 
1@ A(I,J) = 1./(FLOAT(J-1)+. 3+.@1* FLOAT (I) ) 
GO TO 4@ 
20 A(I,J) = FLOAT(I+J) 
GO TO 4@ 
30 ©=AC(I,J) = @. 
46 CONTINUE 
A(J,L) = AC1,J) 
AA(I,J) = A(I,J) 
AA(J,1) = A(J,I) 
5@ CONTINUE 
69 CONTINUE 


C DEFINE CONSTRAINTS 


IF (M.LE.@) GO TO 12 
DO 11@ I=1,M 
D(1) = FLOAT(I+1) - .@5 * FLOAT(I+1) 
DD(I) = D(1) 
DO 10¢@ J=1,N 
C(1,J) = FLOAT (I-J+4) 
GO TO (7@, 80, 70), KEY 
70 C(I,J) = 1./(FLOAT(J-I)+. 2+. Q1* FLOAT (I+J) ) 
GO TO 99 
86 C(1,J) = FLOAT(I-J+4) 
99 CONTINUE 
cC(1,J) = C(I,J) 
100 CONTINUE 
11@ CONTINUE 
12@ CONTINUE 
WRITE (6, 10@2) 
DO 13@ I=1,N 
WRITE (6,10@8) (A(1,J),J=1,N), BCI) 
13@ CONTINUE 
IF (M.LE.@) GO TO 15@ 
WRITE (6,1003) 
DO 14¢ I=1,M 
WRITE (6,1008) (C(1I,J),J=1,N), D(1) 
14@ CONTINUE 
156 CONTINUE 
16@ CONTINUE 


c 
C CALL HSQP TO SOLVE PROBLEM 
C 
CALL HSQP(A, B, C, D, M, N, TAU, G, H, U, IP, MAXRA, MAXRC, 
* DJNORM, X, KRANK) 
c 
c WRITE SOLUTION VECTOR 
€ 
WRITE (6,1007) DJNORM(1), KRANK 
LF (DJNORM(1).LT.@. .OR. N.LE.@) GO TO 226 
WRITE (6,1006) (X(I),I=1,N) 
Cc 
Cc CHECK CONSTRAINTS. 
Cc 


IF (M.LE.@) GO TO 19¢ 

DO 180 I=1,M 

DMCX(I) = DD(I) 

DO 170 J=1,N 

DMCX(L) = DMCX(I) - CC(I,J)*X(J) 
176 CONTINUE 
180 CONTINUE 

WRITE (6,1004) (DMCX(I),I=1,M) 
196 CONTINUE 


os 
Ca 


EVALUATE OBJECTIVE FUNCTION. 


Ae 
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MQARQANQAAGQTAAARAAAAAAAAAAARAAAARANAANAARANAAAANANAAAMAAMAANAAAANAN 


200 
210 


220 
230 


1001 
1692 


VALUE = @. 

DO 210 J=1,N 

SUM = @. 

DO 2¢@ I=1,N 

SUM = SUM + X(1)*AA(I,J) 
CONTINUE 

VALUE = VALUE + (@.5*SUM+BB(J))*X(J) 
CONTINUE 

WRITE (6,1005) VALUE 
CONTINUE 

CONTINUE 


STOP 
FORMAT (5SLHQARARARAAKRARRAEKKKKRRIERERRER ER RK EKER RRR RAER RRR | 


*/31H CASE N M KEY TAU/1X,415,E1@. 3) 


FORMAT (26H@ AUGMENTED MATRIX (A:B) =) 


14603 FORMAT (26H@ AUGMENTED MATRIX (C:D) =) 


1004 
1005 
106 
1007 


1098 


FORMAT (33H@ CONSTRAINT RESIDUALS D - C*X =/(1X, 8E14.3)) 

FORMAT (32H@ VALUE OF OBJECTIVE FUNCTION = , E2@.6) 

FORMAT (16H@SOLUTION VECTOR/(1X, 8E14.6)) 

FORMAT (24H@PROJECTED GRADIENT NORM, 5X, E2@.8/ 13H@RANK OF PROJ, 


* 2Q@HECTED HESSIAN MATRIX, 5X, 1L1@) 


FORMAT (iX, 8E14.6) 
END 


SUBROUTINE HSQP(A,B,C,D,M,N,TAU,G,H,U,IP,MAXRA,MAXRC, DJNORM,X, 
$ KRANK ) 


DIMENSION B(1),D(1),G(1),H(1),U(1), IP (1) ,DJINORM(1) ,X(1) 
DIMENSION A(MAXRA,1),C(MAXRC, 1) 


PROGRAMMER AND DATE: J.T.BETTS, JAN. 1978. 


PURPOSE: GIVEN AN M X N MATRIX C (OF RANK M), AN M VECTOR D, 
AN N X N SYMMETRIC MATRIX A, AND AN N VECTOR B, FIND THE 
STATIONARY POINT X OF THE QUADRATIC 


J = .5%(X#*T)*AeX + (BR*T) *X 
SUBJECT TO THE CONSTRAINTS 
C*X = D, 


IF A STATIONARY POINT DOES NOT EXIST THE ALGORITHM WILL FIND 
A POINT WHICH SATISFIES THE CONSTRAINTS AND MINIMIZES THE 
NORM OF THE GRADIENT OF J PROJECTED ON THE CONSTRAINT SURFACE. 


ALGORITHM; ORTHOGONAL DECOMPOSITION OF C MATRIX USING 
HOUSEHOLDER TRANSFORMATIONS, FOLLOWED BY APPLICATION OF THE 
OPTIMALITY CONDITIONS IN THE REDUCED VARIABLES. 


INPUT: 


A N X N SYMMETRIC HESSIAN MATRIX 

B N DIMENSIONAL GRADIENT VECTOR 

C M X N JACOBIAN MATRIX (RANK M) 

D M DIMENSIONAL CONSTRAINT VECTOR 

M THE NUMBER OF CONSTRAINTS 

N THE NUMBER OF VARIABLES 

TAU PSEUDORANK TEST PARAMETER. FOR A MACHINE WITH K 
SIGNIFICANT FIGURES AN APPROPRIATE VALUE IS 
TAU = 1,.E-(K-2). 


G AUXILLIARY STORAGE (LENGTH M) 

H AUXILLIARY STORAGE (LENGTH N-M) 
U AUXILLIARY STORAGE (LENGTH N-M) 
IP AUXILLIARY STORAGE (LENGTH N-M) 


MAXRA MAXIMUM ROW DIMENSION OF A (MAXRA X N) 
MAXRC MAXIMUM ROW DIMENSION OF C (MAXRC X M) 


OUTPUT: 


DJNORM IF DJNORM .GE. @. IT IS THE NORM OF THE PROJECTED 
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QANQNARAANNANAAANANAAN 


aa 


Q 


Cae 


ae cc ee ec ee A He mS A Se A Sh HS EA CR eS SS SS YS wy SS ye ts 


1¢ 
20 


ee a em me ae me ce ee ce ce ee ee a ae ce me ee eee se Se a ce es ce ee ee ee ee ee ee, 


40 
50 


6@ 
70 


$ 


GRADIENT OF THE CONSTRAINED QUADRATIC FORM. 
IF DJNORM = @. X IS A STATIONARY POINT OF THE 
CONSTRAINED QUADRATIC FORM. 


DJNORM = -1. MEANS INPUT ERRORS. NO X COMPUTED. 
DJNORM = -2. MEANS RANK(C) .LT. M. NO X COMPUTED. 
X COMPUTED SOLUTION VECTOR. IT IS A STATIONARY POINT 


IF DJNORM = @. 


KRANK PSEUDORANK OF PROJECTED HESSIAN MATRIX (K2**T)*A*K2, 


IF KRANK = N-M, X IS THE UNIQUE SOLUTION. 


IF KRANK .LT. N-M, X IS THE MINIMUM LENGTH SOLUTION. 


NOTE: THE INPUT VALUES OF A,B,C, AND D ARE DESTROYED. 


NMM = N - 
DJNORM(1) 


' Ze 


etl Ge 
CHECK FOR INPUT ERRORS 


IF(N.LE.@.OR.N.GT.MAXRA.OR.M.GT.MAXRC.OR.M.GT.N 
-OR. M .LT. @) RETURN 


COMPUTE TOLERANCE, ATOL, FOR PSEUDORANK OF A. 


TEMP = @. 
dO 29 J = 
SUMSQ = @. 
DO 16 I = 1,N 

SUMSQ = SUMSQ + A(I,J)**2 
CONTINUE 

TEMP = AMAX1 (TEMP ,SUMSQ) 

CONTINUE 

ATOL = TAU*SQRT (TEMP) 


IF THE PROBLEM IS UNCONSTRAINED GO TO STEP 6 


IF(M.EQ.@) GO TO 14@ 


STEP. 1. COMPUTE ORTHOGONAL MATRIX K. TRIANGULARIZE C. 


DO 3@ I = 1,M 
CALL H12(1,1,1+1,N,C(1,1),MAXRC,G(1),C(I+1, 1) ,MAXRC,1,M-I) 
CONTINUE 


STEP 2. COMPUTE Y1HAT BY SOLVING THE LOWER TRIANGULAR 
SYSTEM C*¥Y1 = D. STORE IN X. 


TEMP = @. 

DO 5@ J=1,M 

DO 4@ I=J,M 
TEMP=AMAX1 (TEMP, ABS (C(I,J))) 
CONTINUE 

CONTINUE 

CTOL = TAU*TEMP 

DO 99 I = 1,M 

IMl1 =I-1 

X(1) = D(L) 

IF(I .EQ. 1) GO TO 7@ 

DO 60 J = 1,IM1 

X(I) = X(I) - C(I,J)*xX(J) 
CONTINUE 

CONTINUE 


559-P 4- 


0 


COLLECTED ALGORITHMS (cont.) 


aAaANRNAN 


AaAaAaAaaAng 


AAQAANAANA 


180 


$ 


IF(ABS(C(I,1)) .GI. CTOL) GO TO 8@ 
DJNORM(1) = -2. 

RETURN 

CONTINUE 

X(I) = X(I)/C(1,T) 

CONTINUE 


WHEN THERE ARE NO DEGREES OF FREEDOM GO TO STEP 8 


IF(M .LT. N) GO TO 16¢ 
DJNORM(1) = @. 

GO TO 19¢ 

CONTINUE 


STEP 3. COMPUTE ATILDA = (K**T)*A 


DO 119 I = 1,M 
CALL H12(2,1,1+1,N,C(I, 1) ,MAXRC,G(I),A, 1,MAXRA,N) 
CONTINUE 


STEP 4, FORM THE LAST N-M ROWS OF AHAT = ATILDA*K; 
COMPUTE A21HAT = (K2**T)*A*K1 AND A22HAT = (K2**T)*A*K2 


DO 126 I = 1,M 


CALL H12(2,1,1+1,N,C(1,1) ,MAXRC,G(L) ,A(MP1,1) ,MAXRA,1,NMM) 


CONTINUE 


STEP 5. COMPUTE BTILDA = (K**T)*B 


DO 136 I = 1,M 
CALL H12(2,I,I+1,N,C(I,1),MAXRC,G(I),B,1,1,1) 
CONTINUE 


STEP 6. COMPUTE B2HAT = -B2TILDA — A21HAT*Y1HAT 


CONTINUE 
DO 17@ I = MPI,N 

B(L) = -B(I) 

IF(M .EQ. $) GO TO 160 
DO 15¢ J = 1,M 

B(I) = B(L) - A(I,J)*X(J) 
CONTINUE 

CONTINUE 

CONTINUE 


ee i as ee ee ee i ee a a ee ES SS SY 


STEP 7. SOLVE A22HAT*Y2 = B2HAT FOR Y2 USING HFTI 


CALL HFTI(A(MP1,MP1) ,MAXRA,NMM,NMM, B(MP1),1,1,ATOL,KRANK, 


DJNORM,H,U, IP) 
DO 180 I = MP1,N 
X(1) = BCI) 
CONTINUE 
IF THE PROBLEM IS UNCONSTRAINED, RETURN. 


IF(M.EQ.@) RETURN 
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C 
C 
C 


STEP 8. COMPUTE X = K&*Y 


19@ CONTINUE 
DO 200 K = 1,M 


200 


a 


OOOO WOme OMA aaa SS 


C3 0S C2 Oo OP SY Oy or OS 


a 


COL 


4@ 
5@ 


60 
70 


I = MPI1-K 

CALL H12(2,1,I+1,N,C(I,1) ,MAXRC,G(I),X,1,1, 1) 
CONTINUE 

RETURN 

END 


SUBROUTINE H12 (MODE, LPIVOT,L1,M,U, IUE,UP,C,1CE,ICV,NCV) 


ALGORITHM H12: C.L. LAWSON AND R.J. HANSON, "SOLVING LEAST 
SQUARES PROBLEMS'', PRENTICE-HALL,1974. APPENDIX C,P. 368. 


PURPOSE: CONSTRUCTION AND/OR APPLICATION CF A SINGLE 
HOUSEHOLDER TRANSFORMATION ... Q = I + U*(U**T)/B 


MODE = 1 OR 2 TO SELECT ALGORITHM Hl OR H2. 

LPIVOT IS THE INDEX OF THE PIVOT ELEMENT 

L1,M IF LL.LE.M THE TRANSFORMATION WILL EE CONSTRUCTED TO 
ZERO ELEMENTS INDEXED FROM Ll THROUGH M. IF L1.GT.M 
THE SUBROUTINE DOES AN IDENTITY TRANSFORMATION. 

U(), LUE, UP ON ENTRY TO Hl U() CONTAINS THE PIVOT VECTOR. 


IUE IS THE STORAGE INCREMENT BETWEEN ELEMENTS. ON EXIT 


FROM Hl U() AND UP CONTAIN QUANTITIES DEFINING THE 


VECTOR U OF THE HOUSEHOLDER TRANSFORMATION. ON ENTRY TO 


H2 U() AND UP SHOULD CONTAIN QUANTITIES PREVIOUSLY 
COMPUTED BY Hl. THESE WILL NOT BE MODIFIED BY H2. 
C() ON ENTRY TO Hi OR H2 C() CONTAINS A MATRIX WHICH WILL 
BE REGARDED AS A SET OF VECTORS TO WHICH THE 
HOUSEHOLDER TRANSFORMATION IS TO BE APPLIED. ON EXIT 
C() CONTAINS THE SET OF TRANSFORMED VECTORS. 
ICE STORAGE INCREMENT BETWEEN ELEMENTS OF VECTORS IN C() 
ICV STORAGE INCREMENT BETWEEN VECTORS IN C(). 


NCV NUMBER OF VECTORS IN C() TO BE TRANSFORMED. IF NCV.LE.@ 


NO OPERATIONS WILL BE DONE ON C(). 


DIMENSION U(IUE,M),C(1) 
DOUBLE PRECISION SM,B 


IF(@.GE.LPLVOT.OR.LPIVOT.GE.L1.OR.LI.GT.M) RETURN 
CL = ABS(U(1,LPIVOT) ) 
IF(MODE.EQ.2) GO TO 6@ 


CONSTRUCT THE TRANSFORMATION. 


dO 1@ J = L1,M 

CL = AMAX1(ABS(U(1,J)),CL) 

IF(CL) 136,130, 20 

CLINV = 1./CL 

SM = (DBLE(U(1,LPIVOT) ) *CLINV) **2 
DO 3@ J = L1,M 

SM = SM + (DBLE(U(1,J))*CLINV) **2 


SM1 


CONVERT DBLE. PREC. SM TO SNGL. PREC. SMI1 


= SM 


CL = CL*SQRT(SM1) 
IF(U(1,LPIVOT)) 50,50,46 


CL 
UP 


=CL 
U(1,LPIVOT) - CL 


U(1,LPIVOT) = CL 
GO TO 7¢ 


APPLY THE TRANSFORMATION I + U*(U**T)/B TO C 


LF(CL) 130,136,70 
IF(NCV.LE.@) RETURN 
B = DBLE(UP)*U(1,LPIVOT) 
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80 


90 
100 


11¢ 
126 
130 


B MUST BE NONPOSITIVE HERE. IF B=@ RETURN 


IF(B) 806,13¢,130@ 

B = 1.D6/B 

I2 = 1 - ICV + ICE*(LPIVOT-1) 
INCR = ICE*(L1-LPIVOT) 

DO 12@ J = 1,NCV 

I2 = 12 + IcV 

I3 = 12 + INCR 

I4 = 13 

SM = C(12)*DBLE(UP) 

DO 99 I = L1,M 

SM = SM + C(13)*DBLE(U(1,1)) 
I3 = 13 + ICE 

IF(SM) 100,124,100 

SM = SM*B 

C(12) = C(12) + SM*DBLE(UP) 
DO 11¢@ I = L1,M 

C(14) = C(14) + SM*DBLE(U(1,1)) 
I4 = 14 + ICE 

CONTINUE 

RETURN 

END 


SUBROUTINE HFTI(A,MDA,M,N,B,MDB,NB, TAU,KRANK, RNORM,H,G,IP) 


PURPOSE: SOLVE THE MATRIX LINEAR LEAST SQUARE PROBLEM 
MIN NORM(A*X = B) 
WHERE A IS MXN, B IS MXNB, X IS NXNB. 


REF. C.L. LAWSON AND R.J. HANSON, "SOLVING LEAST SQUARES PROBLEMS 
PRENTICE-HALL, 1974. ALGORITHM HFTI, APPENDIX C.,P.29@. 


DIMENSION A(MDA,N),B(MDB,NB) ,H(N) ,G(N) ,1P(N) , RNORM(NB) 
DOUBLE PRECISION SM,DZERO 


SZERO = @. 
DZERO = @.D@ 
FACTOR = .OO61 


K = @ 
LDIAG = MIN@O(M,N) 
IF(LDIAG.LE.@) GO TO 27@ 


DO 8@ J = 1,LDIAG 
IF(J.EQ.1) GO TO 2¢ 


UPDATE SQUARED COLUMN LENGTHS AND FIND LMAX 


LMAX = J 
DO 16 L = J,N 

H(L) = H(L) - A(J-1,L)**2 
LF(H(L).GT.H(LMAX)) LMAX = L 
CONTINUE 

LF (FACTOR*H(LMAX)) 20, 206,50 


COMPUTE SQUARED COLUMN LENGTHS AND FIND LMAX 


LMAX = J 
DO 49 L = J,N 
H(L) = @. 


DO 3¢ I = J,M 

H(L) = HCL) + A(I,L)**2 
IF(H(L).GT.H(LMAX)) LMAX = L 
CONTINUE 

HMAX = H(LMAX) 


LMAX HAS BEEN DETERMINED. DO COLUMN INTERCHANGES IF NEEDED. 
CONTINUE 


IP(J) = LMAX 
IF(IP(J).EQ.J) GO TO 76 
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DO 6@ I = 1,M 

TMP = A(I,J) 
A(I,J) = A(I,LMAX) 
A(I,LMAX) = TMP 
H(LMAX) = H(J) 


COMPUTE THE J-~TH TRANSFORMATION AND APPLY IT TO A AND B. 


CALL H12(1,J,J+1,M,A(1,J),1,H(J),A(1,J+1),1,MDA,N-J) 
CALL H12(2,J,J+1,M,A(1,J),1,H(J),B,1,MDB,NB) 


DETERMINE THE PSEUDORANK,K, USING THE TOLERANCE, TAU 


DO 99 J = 1,LDIAG 
IF(ABS(A(J,J)).LE.TAU) GO TO 100 
CONTINUE 

K = LDIAG 

GO TO 11 

K2=J-1 

KP] =K+1 


COMPUTE THE NORMS OF THE RESIDUAL VECTORS. 


IF(NB.LE.@) GO TO 14 
DO 13@ JB = 1,NB 

TMP = SZERO 
IF(KP1.GT.M) GO TO 139 
DO 126 I = KP1,M 

TMP = TMP + B(1,JB)**2 
RNORM(JB) = SQRT(TMP) 
CONTINUE 


SPECIAL FOR PSEUDORANK = @. 


IF(K.GT.@) GO TO 160 
IF(NB.LE.@) GO TO 270 
DO 15@ JB = 1,NB 

po 15¢ I = 1,N 
B(L,JB) = SZERO 

GO TO 27@¢ 


IF THE PSEUDORANK IS LESS THAN N COMPUTE HOUSEHOLDER 
DECOMPOSITION OF FIRST K ROWS. 


IF(K.EQ.N) GO TO 18¢@ 

DO 17@ IL = 1,K 

I = KP1 - II 

CALL H12(1,I1,KP1,N,A(1,1),MDA,G(I),A,MDA,1,I-1) 
CONTINUE 


IF(NB.LE.@) GO TO 27@ 
DO 26¢@ JB = 1,NB 


SOLVE THE K BY. K TRIANGULAR SYSTEM 


DO 21¢ L = 1,K 

SM = DZERO 

I = KPL-L 

IF(L.EQ.K) GO TO 2¢¢ 

IPl=I+1 

DO 199 J = IP1,K 

SM = SM + DBLE(A(1,J))*DBLE(B(J,JB)) 
SM1 = SM 

B(I,JB) = (B(I,JB)-SM1)/A(1,1) 


COMPLETE COMPUTATION OF SOLUTION VECTOR 


IF(K.EQ.N) GO TO 24@ 

DO 22¢ J = KP1,N 

B(J,JB) = SZERO 

DO 23@ I = 1,K 

CALL H12(2,1,KP1,N,A(1,1),MDA,G(1),B(1,JB),1,MDB,1) 


REORDER THE SOLUTION VECTOR TO COMPENSATE FOR THE COLUMN 


INTERCHANGES . 
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C 

24@ DO 25¢ JJ = 1,LDIAG 
J = LDIAG +1 - JJ 
IF(IP(J).EQ.J) GO TO 250 
L = IP(J) 
TMP = B(L,JB) 
B(L,JB) = B(J,JB) 
B(J,JB) = TMP 

250 CONTINUE 

26@ CONTINUE 


THE SOLUTION VECTORS, X, ARE NOW IN THE FIRST N ROWS OF THE 
ARRAY B(.) 


aagaaAN 


270 KRANK = K 
RETURN 
END 
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ALGORITHM 560 

JNEF, An Algorithm for Numerica! 
Computation of the Jordan Normal Form 
of a Complex Matrix [F2] 


BO KAGSTROM and AXEL RUHE 
University of Umea, Sweden 


Key Words and Phrases: Jordan normal form, canonical form, eigenvalues, eigenvectors, principal 
vectors, block diagonal form 

CR Categories: 5.14 

Language: Fortran 


DESCRIPTION 


1. Introduction 


The routines given here are the actual Fortran implementation of the algorithm 
presented and discussed in [2]. We describe in detail how to use the Fortran 
subroutines and how to reach the results from a call. We also give some comments 
on the code that might be of value when implementing the subroutines on a 
particular machine. The subroutines have been checked with the PFORT verifier 
[4] and the notation from [2] is used. 


2. The User-Written Routine DECIDE 


‘DECIDE is a user-written subroutine which makes it possible for the user to 
change the grouping and/or the values of the numerical multiple eigenvalues. . 

This routine is useful when we have some information on the eigenvalues and 
their multiplicities in advance, and want the eigenvectors and ‘the principal 
vectors for the given matrix. For instance, if we know of physical reasons why 
zero should be the only possible multiple eigenvalue and all others simple, then 
the contents of the parameters should be changed as indicated in Table I. 

If the user does not want to influence the grouping or the values of the 
eigenvalues, it is enough to define a dummy subroutine, i.e., 


SUBROUTINE DECIDE (NM, N, NDEL, CSHTR, CSHTI, NBLOCK, HR, HI) 
RETURN 
END 


3. The Rank Determination Process and the RDEFL Routine 


The rank determination process is described in [2, Section 2.2 and Section 3, Step 
6 of the algorithm]. According to these two alternatives we have two subroutines 
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Table I. Example of Use of the 


Subroutine DECIDE 
On entry 
N= 10 On exit 
NBLOCK = 6 NBLOCK = 7 


NDEL CSHT NDEL CSHT 


0 —1.5 0 y-1é 
1 0.002 1 0.0 
5 2.4 5 H(6, 6) 
7 3.5 H(7, 7) 


RDEFL—one for the singular value decomposition strategy and one for the 
Kublanovskaya (RQ) decomposition strategy. Only the routine based on singular 
value decomposition is presented here. 

In the RDEFL routine we use the CSVD algorithm [1] with one change; 
namely, we sort the singular values in increasing instead of decreasing order as in 
the original program. 


4. How to Reach Any of the Vectors 


The eigenvectors and principal vectors are stored in the arrays ZR, ZI(NM, N). 
To find the vectors, we use the information stored in NBLOCK, NDEL, NDB, 
NDEFL, and NXT (see the parameter list of subroutine JNF). 

The column indices K in ZR and ZI for eigenvectors, principal vectors, and 
principal chains of an eigenvalue are listed below in Algol for-statement notation. 


(a) Find the eigenvectors of the multiple eigenvalue 
I=1,..., NBLOCK. 
J := NDB[I]; 
for K := NDEL[I] + 1 step 1 until NDEFL[J + 1] — 1 do; 
Find the principal vectors of grade P to the eigenvalue I = 1,..., NBLOCK. 
J := NDB[I] + P - 1; 
for K := NDEFL{[J] step 1 until NDEFL[J + 1] — 1 do; 
(c) Find the principal chain which ends with the eigenvector in column L. 
First: 
(A — EV[L]*«D*Z[L] =0 (eigenvector) 
Then: 
K1 := L; 
for K := NXT[K1] while K > 0 do 
begin 
Here: 


(b 


— 


(A — EV[K]+I)*Z[K] = SUPD[K1]*Z[K1]; (principal vector) 
K1:=K 
end; 
(Here we use the fact that the diagonal elements may be different as in [2, eq. 
(4.2)]. To get chains of the nilpotent B, EV[K] should be replaced by EV[L].) 
In Table II we list the values of NDEL, NDEFL, NXT, NDB, and SUPD for 


the first test matrix in [2, Section 5]. 


5. Comments on the Fortran Code 


Since we use the EISPACK routines CBAL, COMHIES, COMLR2, and CBABK2 
[5], we have their representation of complex arrays, ie., the real parts are 
represented in one array with the name ending in R (e.g., HR, ZR) and the 
imaginary parts are represented in one array with the name ending in I (e.g., HI, 
ZI). This representation makes it possible to execute most of the computations in 
real arithmetic. 

We use real arithmetic in all steps of the algorithm except Steps 4 and 7, i.e., 
the elimination processes, where we use some complex arithmetic. 
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Table II. Example of Output of Index Vectors 
NDEL NDB NDEFL NXT SUPD 
0 


— 


SCHearIrTaTh ONE 
—_ 
coocoooomn 
SOC C COCO OmM mE 
CMH OMINTORGW 
go 
—_ 
Cw 
— 
_ 


roy 
Oo 
oO 


Note. Output for the first test matrix in [2] is displayed. 


Because of this complex arithmetic we also have to use the complex standard 
functions REAL(X), AIMAG(X), and CMPLX(X, Y). 

If the actual Fortran compiler does not accept complex arithmetic, we can 
implement the functions CMUL, CDIV, CADD, and CSUB from [6] and substi- 
tute the actual statements with new statements. 

A new parameter (NOBACK) has been added to the EISPACK routine 
COMLR2. We use this parameter (NOBACK = 0) as a control so that we do not 
get the eigenvectors from COMLR2. We get the transformations which transform 
the matrix to upper triangular form. 

In the RDEFL routine we use complex arrays and arithmetic since the routine 
CSVD1 [1] is made for complex arithmetic. 


6. Numerical Experiments 


We have performed several numerical tests, both on matrices with a well-defined 
Jordan normal form, and on cases specially constructed in order to provide the 
routine with difficulties. Results from full Jordan normal form reduction are 
reported and discussed in [2]. In [2, Section 4] we describe how to choose 
tolerance parameters in the grouping procedure and in the procedure for deter- 
mining the structures inside the invariant subspaces corresponding to different 
numerical multiple eigenvalues. We also describe how to analyze the results from 
the program, given a combination of the tolerance parameters. 

A large number of results from block diagonal reductions (ISTEP = 5 and 6) 
are reported and discussed in [3]. 
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ALGORITHM 


[Summary information and a part of the listings are printed here. The complete 
listing is available from the ACM Algorithms Distribution Service (see inside 
back cover for order form) or may be found in microfiche form in “Collected 
Algorithms from ACM.” ] 


NAME(n): indicates a Fortran module with n records 
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14 


12 


aa 


Aaganananaananannanananaananaanannaan 
Fe HH HH HF HF HH HF FH HH HH HH FH SF 


NAME'(n): indicates “NAME” is included for testing purposes 


Contents: 


MAIN"(828), RESID" (75), DECIDE" (56), MATRIS"(43), 


MATRS17(32), MATRS3" (55), MATRS4" (62), MATRS57 (42), 


JNF (834), RDEFL(132), CBAL(209), COMHES(138), 


COMLR2(405), CBABK2(91), CVSD1(384), OUTPUT" (33), 


MATBLK1(37), MATRS2" (148) 


SUBROUTINE DECIDE (NM,N, NDEL,CSHTR, CSHTI,NBLOCK,HR,HI) 
KKEKKERERKKREKR RARER KK RRRK KR KRERERRERERRRERRRRERRRRERRREKRRRERRERRER 


DECIDE IS A USER WRITTEN SUBROUTINE WHICH MAKES IT POSSIBLE 
FOR THE USER TO CHANGE THE GROUPING OF THE NUMERICAL MUL- 
TIPLE EIGENVALUES,AND/OR CHANGE THE VALUES OF THE MULTIPLE 
EIGENVALUES. 

THE FORMAL PARAMETER LIST 


NM THE ROW DIMENSION OF THE TWO-DIMENSIONAL ARRAY 
PARAMETERS (HR,HI)AS DECLARED IN THE CALLING 
PROGRAM DIMENSION STATEMENT 

N THE ORDER OF THE ORIGINAL MATRIX 

NBLOCK THE NUMBER OF BLOCKS I.E THE NUMBER OF NUMERICAL 
MULTIPLE EIGENVALUES 

CSHTR, THE REAL AND IMAGINARY PARTS,RESPECTIVELY,OF THE 

CSHTI NUMERICAL MULTIPLE EIGENVALUES 

NDEL INDICATES THE MULTIPLICITY OF THE NUMERICAL 
MULTIPLE EIGENVALUES .NDEL(I+1)-NDEL(L)=THE 
MULTIPLICITY OF EIGENVALUE I FOR I=1,..,NBLOCK 

HR, HI THE REAL AND IMAGINARY PARTS,RESPECTIVELY, OF 


THE UPPER TRIANGULAR MATRIX RESULTING FROM 
STEPS 1-3 OF THE ALGORITHM 


NOTE -- THE USER MUST NOT CHANGE HR,HI 


INTEGER NDEL(N) 
REAL HR(NM,N),HI(NM,N),CSHTR(1),CSHTI(1) 
WRITE (6, 9) 


9 FORMAT(1H@,1X,47HTHE FOLLOWING OUTPUT (A,B AND C) ARE PRINTED BY, 


* 
* 


31HTHE USER WRITTEN ROUTINE DECIDE/ 
1H@,1X,31HSEE SECTION 2 OF THE ALGORITHM.) 


WRITE(6, 10) 

WRITE(6,11) (HR(K,K),K=1,N) 

WRITE(6,11) (HI(K,K) ,K=1,N) 

WRITE(6, 12) 

DO 1 K=1,NBLOCK 

MULT=NDEL (K+1)-NDEL (K) 

WRITE(6, 13) NDEL(K+1),MULT, CSHTR(K) , CSHTI (K) 
1 CONTINUE 

WRITE(6, 14) 


i 


FORMAT (1H@, 1X, 34HC--IN STEP 6 OF THE ALGORITHM THE , 
5@HSTRUCTURE OF EACH MULTIPLE EIGENVALUE IS COMPUTED. 
/1H@,1X,42HFOR THAT REASON RDEFL SUCCESIVELY COMPUTES, 
44H SINGULAR VALUE DECOMPOSITIONS. RDEFL PRINTS 

/1H@, 1X,39HTHE RESULTS BELOW(SEE ALSO COMMENTS IN , 


35HRDEFL AND STEP 6 OF THE ALGORITHM). ) 


1¢ POAT ING 1X, 43HA--ENTER DECIDE WITH EIGENVALUES COMPUTED 


ie 


36HBY COMLR2 (STEP 1 OF THE ALGORITH™M )) 


FORMAT(1@F13. 9) 
FORMAT (1X, 49HB--GROUPINGS OF THE EIGENVALUES, COMPUTED, 


* 27H BY STEP 3 OF THE ALGORITHM) 
13 FORMAT(12H DIVISION AT,I4, 7H MULT.=,I14, 8H CENTER=, 2E20.1@) 
RETURN 


END 


SUBROUTINE JNF (NM,N,HR,HI, ZR, ZI,EVR,EVI,SUPD,NXT,NDEL,NDEFL,NDB, 


CNBLOCK, EIN, TOL, DELE, SM, LERR, ISTEP) 


REAL HR(NM,N),HI(NM,N),ZR(NM,N), ZI (NM,N) ,EVR(N), EVI(N) ,SUPD(N), 


CDELE(N) , SM(N) 
INTEGER NXT(N) ,NDEL(N) ,NDEFL(N) , NDB(N) 


KREKKKREREKRKEKERRRRRERRRRERRERRRRERRERERR RR RERRRERRRRRREREREKRREREERR RE 


* THE FORMAL PARAMETER LIST 


RARRKRREKRRRKRERRRKERRRRRRRERREERRRRRERERREERRRRRERE RRR RERERRRRRREKER 


> 


000064040 
60004050 
60004060 
0004070 
0004080 
00004090 
69004160 
90004110 
00004126 
06004130 
60004149 
00004150 
00004160 
909904176 
090004180 
00004190 
00004200 
90004210 
00004220 
90004230 
99004246 
00064256 
00004260 
90004270 
0004280 
00004290 


99004300 
06004310 
00004320 
06004330 
09004340 
06004 350 
00004360 
00004370 
090064380 
00004390 
009004400 
00004410 
00004420 
09004430 
06004440 
00004450 
00004460 
00004470 
09004480 
09004490 
09004500 
06004516 
00004520 
00004530 
00004540 
00004550 
00004560 
90064570 
09904586 
069004590 


90006940 
00006956 
90606960 
00006976 
09006980 
00006990 
0007000 
00007010 
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00007020 

ON INPUT - 90007030 
00007040 

NM - MUST BE SET TO THE ROW DIMENSION OF THE TWO- 0000670650 
DIMENSIONAL ARRAY PARAMETERS AS DECLARED IN 0600670660 

THE CALLING PROGRAM 000067070 

N - IS THE ORDER OF THE MATRICES 00007080 
00607090 

HR,HI - CONTAIN THE REAL AND IMAGINARY PARTS,RESPECTIVELY 90007100 
OF THE COMPLEX MATRIX 00007110 

EIN - IS A TOLERANCE PARAMETER,CORRESPONDING TO 000067120 
PERTURBATIONS OF HR,HI, AND IS USED IN THE 000067130 
GROUPING OF NUMERICAL MULTIPLE EIGENVALUES 00007140 
00007150 

TOL - IS A TOLERANCE PARAMETER USED IN THE CONSTRUCTION $06007160 
OF THE NILPOTENT MATRICES (IS USED IN RDEFL) 00007170 
00007180 

ISTEP —- RETURN FROM JNF AFTER STEP ISTEP (=1, 2,3,4, 5,6, 7) 00007190 
FULL REDUCTION TO JORDAN FORM IF ISTEP .GE. 7 606067200 

OTHER CHOICES GIVE REDUCTION TO 00007210 

90007220 

1 UPPER TRIANGULAR FORM 00007230 
000607240 

2 UPPER TRIANGULAR FORM WITH THE ELGEN- 00007250 
VALUES SORTED SUCH THAT CLOSE EIGEN- $000 7260 

VALUES APPEAR IN ADJACENT POSITIONS 00007276 

090007280 

3 THE SAME AS 2,IN ADDITION GROUPING OF 00007290 
CLOSE EIGENVALUES INTO BLOCKS CORRE- 000073060 

SPONDING TO NUMERICAL MULTIPLE EIGEN- $06007310 

VALUES $0007 320 

000607330 

4 BLOCK DIAGONAL UPPER TRIANGULAR FORM 00007340 
00007350 

5 BLOCK DIAGONAL UPPER TRIANGULAR FORM 00007360 
AND THE INVARIANT SUBSPACES CORRESPONDING 000607370 

TO THE DIAGONALS BLOCKS HAVE UNITARY BASES 60007386 

000667390 

6 THE STRUCTURE OF EACH DIAGONAL BLOCK IS 00607460 
DETERMINED 00007410 

ON OUTPUT - 60007426 
090007430 

THE PARAMETERS CONTAIN USEFUL INFORMATION DEPENDING ON 00007446 
THE VALUE OF THE INPUT PARAMETER ISTEP. 00007450 
00607460 

NOTATION - (IF ISTEP .GE. N ) 60007470 
WHERE N IS 1,2,3,4,5,6 OR 7 00007480 
00007490 

060607500 

HR,HI - HAVE BEEN DESTROYED 60007510 
00007526 

IERR - IS A CONVERGENCE PARAMETER SET BY COMLR2 900607530 
@ FOR NORMAL RETURN 00007540 

J IF THE J-TH EIGENVALUE HAS NOT BEEN DETERMINED $0007550 

AFTER 3@ ITERATIONS 60007566 

IF AN ERROR EXIT IS MADE (IERR.NE.@),NONE $0007570 

OF THE FOLLOWING PARAMETERS CONTAIN MEANINGFUL 00007586 

RESULTS 00007590 

(IF ISTEP.GE.1) 00007600 

EVR, EVI CONTAIN THE REAL AND IMAGINARY PARTS,RESPECTIVELY 4040761 
OF THE EIGENVALUES. 00007620 

IF ISTEP.GE.1 BUT .LT.5 THE EIGENVALUES ARE 00007630 
COMPUTED BY COMLR2. 00007640 

IF ISTEP.GE.6, EVR,EVI CONTAIN THE MAIN DIAGONAL 0007650 

OF THE JORDAN MATRIX. 00007660 
000607670 

NBLOCK-- IS THE NUMBER OF NUMERICAL MULTIPLE EIGENVALUES 006067680 
(IF ISTEP.GE.3) 90007690 
00007700 

NDEL - INDICATES THE MULTIPLICITIES OF THE NUMERICAL 000607716 
MULTIPLE EIGENVALUES 00007726 

(IF ISTEP.GE.3) 60007730 
NDEL(I+1)-NDEL(1)= MULTIPLICITY OF EIGENVALUE 00007746 

I FOR I=1,...,NBLOCK 00007750 

NDEFL - INDICATES THE STRUCTURE OF HR,HI 60007760 
(IF ISTEP.GE.6) 00007770 
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SUPD - 


NXT = 


NDB = 


ZR,ZI - 


DELE - 


SM - 


FOR COMPLETE 
THE TEXT 


CONTAINS THE REAL SUPERDIAGONAL OF THE JORDAN 
MATRIX (THE COUPLING ELEMENTS) 


(IF ISTEP.GE.7) 


CONTAINS THE COLUMN INDICES OF SUPD 

NXT(I)=J IMPLIES THAT THE VECTOR WITH COUPLING 
ELEMENT SUPD(I) IS PLACED IN COLUMN 
J OF ZR,zI 

(IF ISTEP.GE.7) 

CONTAINS POINTER REFERENCES 

NDB(I)=J MEANS THAT INFORMATION ABOUT THE 
STRUCTURE OF THE NUMZRICAL MULTIPLE 
EIGENVALUE I STARTS IN POSITION J 
OF NDEFL 

(IF ISTEP.GE.6) 

CONTAIN THE REAL AND IMAGINARY PARTS,RESPECTIVELY 

OF THE ACCUMULATED TRANSFORMATIONS FROM STEP 1 

TO 7 OF THE ALGORITHM. 

IF ISTEP.GE.7, ZR,ZI ARE THE IGENVECTORS AND 

THE PRINCIPAL VECTORS. 


CONTAINS INFORMATION ABOUT DELETED ELEMENTS 


00007780 
60007790 
00007800 
40607810 
09007820 
00007830 
00007840 
90007850 
00007860 
00007876 
09007880 
00007890 
09007900 
00007910 
00007926 
000079 30 
00607940 
00607950 
00007960 
00007970 
0006079 80 
00007990 
09O08000 


DURING THE PROCESSES OF FINDING NILPOTENT MATRICES@¢008010 


DELE(I)= EUCLIDEAN NORM OF DELETED PART FOR BLOCK 
I FOR I=1,...,NBLOCK 
(IF ISTEP.GE.6) 


CONTAINS ESTIMATES OF THE SPECTRAL PROJECTORS 
CORRESPONDING TO DIFFERENT NUMERICAL MULTIPLE 
EIGENVALUES 

(IF ISTEP.GE.4) 


DESCRIPTION SEE COMPUTATIONAL DETAILS IN 


90008020 
99008030 
00008040 
00068050 
40068060 
06908070 
99908080 
00008090 
00008100 
00008110 
90008120 
00008130 
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DESCRIPTION 


1. Introduction 


In many computational problems one has a collection of entities whose time 
history is being studied. The calculation proceeds by creating, destroying, and 
generally processing these entities, henceforth called nodes. Often the node to be 
processed is that one which is “most important” in some problem-dependent 
sense. Examples of such calculations occur in particle following for accelerator 
problems and adaptive quadrature, to name but two [8, 4, 6]. In such problems 
the time spent maintaining the nodes is significant, and it is important to 
implement this efficiently. . 

An organization of nodes based on “most important in, first out” (i.e., where 
every deletion removes the most important node) is called a priority queue [5]. 
The computer implementation of such queues can vary considerably. An unor- 
dered table of nodes is the simplest arrangement but requires an expensive search 
for the most important node. Maintaining an ordered table allows easy access to 
the most important node, but then insertions become slow. A “heap” [1] is a data 
structure that implements a priority queue in an efficient way, being equally fast 
for both insertions and deletions. Here we present a suite of Fortran programs of 
library quality for heaps. These programs are of modest length and can easily be 
included in other packages. Similar programs were used in [6] but they were not 
found to be general enough for library use. 

In this paper we do not describe any of the detailed properties of heaps since 
these have been well documented [1, 7]. Rather we give only enough information 
about them so that the use of the programs can be quickly understood. The last 
section contains two simple examples. 

In our implementation the work required to form the heap from N given nodes 
is O(N), and the work required either to remove the most important and update 
or to insert and update is O(log, N). This data structure is appropriate if the 
current most important node might be processed and destroyed before other 
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Fig. 1. Example of table management with heaps 
versus in-line DO loops. 


nodes are created; the data structure is less appropriate if all the nodes are 
created before any are processed and destroyed. 

The advantages of the programs presented in this paper over more familiar 
searching techniques are illustrated in Figure 1. Here we compare calls to the 
heap subroutines with in-line DO loops for the management of variously sized 
tables. This computation was selected to maximize the advantage of the in-line 
programming. (Specifically, example 1 of Section 3 was reprogrammed to use a 
DO loop at each stage to find the maximum element in an unordered table.) More 
typical problems should produce even more favorable time comparisons. For 
example, the production program MARLOWE, available from the Argonne Code 
Center, can have its execution time reduced 95 percent by using heaps instead of 
linear searches. 


2. Using the Programs 


We take a node to be one or more consecutive words of computer memory, with 
the data in these words defining the node. To investigate particle interactions 
(e.g., in an accelerator beam), each node could represent one particle, the nodal 
fields being position in phase space, energy, etc. For adaptive quadrature a node 
represents a portion of the region of integration; the fields in the node give the 
physical description of the region as well as local quadrature and error estimates. 
The most important node could be associated with the particle of largest energy 
or, for quadrature, the subregion with largest or smallest error, error per unit 
volume, that region nearest the origin, etc. To implement this variety, we require 
a Boolean function, HPFUN, on the nodes. Given two nodes A and B, this 
function returns . TRUE. if node A is “more important” than node B. The most 
important node is called TOP (i.e., it is the one for which HPFUN (TOP, X) = 
.TRUE. for any other node X). 

Operations that can be performed on the heap, corresponding subroutines, and 
calling sequence parameters are shown in Table I. We also show (for complete- 
ness) the form of the Boolean HPFUN as well as an internally used subroutine 
HPGRO. A description of the parameters is given later. 

The usual sequence of calls begins with HPINIT, perhaps followed by HPBLD. 
The main calculations usually require numerous calls to HPINS, HPACC, and 
HPDEL in various orders and combinations. 

The package stores nodes into and removes them from a scratch area (DATA) 
provided by the user. The function HPFUN is an argument to the subroutines 
and thus may be changed from run to run or even during a single run. The latter 
situation might be useful during a calculation in which too many nodes are being 
generated. 

The subroutine parameters are as follows: 


NMAX Maximum number of nodes permitted, set by user. 

NWDS Number of words per node, set by user. 

DATA Real work array, at least NMAX * NWDS words, dimensioned by the 
user for node storage. 


COLLECTED ALGORITHMS (cont.) 


Table I. Heap Functions, Subroutines, and Calling Sequence Parameters 


Function Subroutine Calling sequence parameters 
Initialize package at start HPINIT NMAX, N, T 
of each calculation 
Build a heap HPBLD NMAX, NWDS, DATA, N, T, 
HPFUN 
Insert a node HPINS NMAX, NWDS, DATA, N, T, 
XNODE, HPFUN 
Delete top node HPDEL NMAX, NWDS, DATA, N, T, 
HPFUN 
Access a node HPACC NMAX, NWDS, DATA, N, T, 
(K = 1 gives top) XNODE, K 
Determine the “more im- HPFUN? A, B, NWDS 
portant” of two given 
nodes 
Internally used subroutine HPGRO NMAX, NWDS, DATA, N, T, 
HPFUN, I 


* Generic name—user may supply his own, but name must be EXTERNALed. 


XNODE 


HPFUN 


Current number of nodes in the heap, set by the package. 

Integer work array dimensioned at least NMAX by the user, defined 
and used internally as a pointer. 

Real array of NWDS words dimensioned by the user and used to store 
a single node. Thus to insert a node via HPINS, the user forms 
XNODE, i.e., defines its NWDS words and calls HPINS to copy these 
into the heap. To access a node with HPACC, the package copies the 
nodal data into XNODE (see examples). 

Name of a logical function with two real parameters and one integer 
parameter, of the form 


LOGICAL FUNCTION HPFUN (A, B, NWDS) 
INTEGER NWDS 
REAL A(NWDS), B(NWDS) 


The name of this function must be included in an EXTERNAL 
statement in the user calling program. When this function is called by 
the package, the arguments A and B will be two different nodes. The 
package provides two Boolean functions, LESS and GREATR, defined 
by 
LESS = A(1) .LT. B() 
GREATR = A(1) .GT. B(1) 


These functions may be used when the characteristic on which the 
heap is organized appears in the first word of each node. The LESS 
and GREATR functions make the TOP smallest or largest, respec- 
tively. If the user wants more complicated functions, he must write 
them himself. For example, to select the node that is closest to the 
origin in the sense of the sum of squares of components, we can write 


LOGICAL FUNCTION L2 (A, B, NWDS) 
INTEGER NWDS, I 
REAL A (NWDS), B (NWDS), DA, DB 
DA = 0.0 
DB = 0.0 
DO 11=1, NWDS 
1 DA = DA + A (I)**2 
DB = DB + B (1)**2 
L2 = DA .LT. DB 
RETURN 
END 
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K (In SUBROUTINE HPACC) the index of the node to be accessed; set 
by user. K = 1 corresponds to the TOP, and K must be in the range 
1=K<=N Ss NMAX. (Since the heap is only partially ordered, there 
is no way to predict the node produced by using this subroutine with 
K > 1. It is allowed as a convenience to those users who may wish to 
examine all the nodes without altering the heap structure.) 


Note. If subroutines in the package are called with incorrect arguments, e.g., 
N > NMAX, the programs return without performing any calculations. No error 
diagnostics are given. 


Operation Counts. The initialization program HPINIT and the infrequently 
used HPBLD require O(N) operations. Inserting or deleting a node, HPINS or 
HPDEL, requires O(log: N) operations; accessing a node with HPACC requires 
O(1) operations and has no effect upon the heap. 


3. Examples of Use 


Our first example is trivial. It has no application except to illustrate the use of the 
package. Nevertheless it forms the framework for the second example, adaptive 
quadrature, an important algorithm. 


Example 1. A Simple Example of Heap Subroutines 


A node is a single real number, between 0 and 1, generated at random. The TOP 
node in the heap is that one with largest numerical value. The calculation is as 
follows. Start with an initial node. While the number of nodes is less than 1000, 
print the value of the TOP node, remove it from the heap, and replace it by two 
others also selected at random. The complete Fortran program is as follows: 


REAL DATA (1000), XNODE 
INTEGER T(1000) 
EXTERNAL GREATR 
LOGICAL GREATR 


NMAX = 1000 
CALL HPINIT (NMAX, N, T) 
XNODE = RANNUM (0.) 
CALL HPINS (NMAX, 1, DATA, N, T, XNODE, GREATR) 
C 
1 IF(N .GE. NMAX) STOP 
CALL HPACC (NMAX, 1, DATA, N, T, XNODE, 1) 
WRITE (6,100) XNODE 
CALL HPDEL (NMAX, 1, DATA, N, T, GREATR) 
XNODE = RANNUM (0.) 
CALL HPINS (NMAX, 1, DATA, N, T, XNODE, GREATR) 
XNODE = RANNUM (0.) 
CALL HPINS (NMAX, 1, DATA, N, T, XNODE, GREATR) 
GO TO 1 
100 FORMAT (E16.8) 
END 


Example 2. Global Adaptive Quadrature 


We start with an initial interval, a user-provided subroutine for evaluating the 
integrand, and « > 0. The algorithm generates subintervals by bisection and 
produces an integral estimate and error estimate for each. The subinterval 
subdivided next is that one having largest error estimate. The algorithm termi- 
nates where the sum of subinterval error estimates is less than e. This is the 
prototype algorithm on which heaps were successfully used in [6]. A node is a 
real four-word array corresponding to an interval arid has the form 


NODE, = error estimate 2: 0 
NODE: = integral estimate 
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NODE; = left endpoint 
NODE, = right endpoint 


The heap is organized so that the TOP is the node with the largest error estimate. 
Thus the function GREATR provided in the package is used. 

The main user subroutine is AGQ. Auxiliary calculations use the user-written 
programs: 


QINIT Initializes the first interval to a node. 

QSDVD Produces two half-interval nodes from each full interval. 

QUAD Provides integral estimate and error estimate for the user function on 
a given node. 


In our sample program integral/error estimates are calculated by 2- and 3-point 
Gauss quadrature. This is, however, independent of any other aspect of the 
algorithm, and readers may substitute Newton-Cotes, Kronrod, etc. Our program 
has not taken advantage of the fact that for this problem a deletion is always 
followed by an insertion; the gain by doing this is very small. Furthermore the 
favorable timings of the heap programs relative to a simple list only appear after 
about 100 nodes, a situation which does not occur for the two problems in the 
example. On the other hand, for automatic integrators small gains in efficiency 
are not a major issue for problems generating such a small number of nodes. This 
same simple program organization can be used, however, for multidimensional 
adaptive quadrature after obvious changes in the definition and storage require- 
ments for a node. For these problems large numbers of nodes can easily be 
generated. The program of Example 2 is a prototype of the library software that 
is now being developed in this area. For more complex applications of these ideas 
see [2] and [4]. 
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ALGORITHM 
REAL WORK(10@@), TNODE(4) MAIN L 
INTEGER IWORK(20@) MAIN 2 
EXTERNAL F,G,LEFT MAIN 3 
LOGICAL LEFT MAIN 4 
C MAIN 5 
C TEST DRIVER TO ILLUSTRATE THE USE OF HEAP SUBROUTINES FOR MAIN 6 
C QUADRATURE. MAIN 7 
C THIS PROGRAM CALLS THE ADAPTIVE QUADRATURE SUBROUTINE AGQ MAIN 8 
C TO INTEGRATE THE TWO FUNCTIONS MAIN 9 
C F(X) =EXP (X) MAIN 16 
C AND MAIN ll 
C G(X)=1. /SQRT(X) MAIN 12 
C ON (@., 1.) TO AN ABSOLUTE ACCURACY OF 1.E-@5 MAIN 13 
C THE DEFINITIONS OF THE ARGUMENTS TO SUBROUTINE AGQ ARE GIVEN MAIN 14 
C IN THE COMMENTS FOR THAT SUBROUTINE. MAIN 15 
C FOR EACH OF THESE TWO PROBLEMS THIS TEST PROGRAM PRINTS MAIN 16 
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Q = THE COMPUTED ESTIMATE OF THE INTEGRAL 

E = THE COMPUTED ESTIMATE OF THE ERROR 

N = THE NUMBER OF SUBINTERVALS IN THE FINAL PARTITION OF 
THE INTERVAL (@., 1.) 

IFLAG = A SUCCESS (@) OR FAILURE. (1) INDICATOR. 


CALL AGQ(@.,1.,F,1.E-@65, Q,E,N, 100, WORK, [WORK , IFLAG) 
WRITE (6,12) 

WRITE(6, 100) Q,E,N, IFLAG 

CALL AGQ(@.,1.,G, 1.E-@5,Q,E,N, 160, WORK, IWORK, IFLAG) 
WRITE (6, 100) Q,E,N, IFLAG 


AFTER THE SECOND PROBLEM WE REORGANIZE THE HEAP SO THAT THE 
ROOT INTERVAL IS THE LEFTMOST ONE, AND THEN PRINT THE 
SUBINTERVALS USED LEFT TO RIGHT. 


CALL HPBLD (100, 4, WORK, N, IWORK, LEFT) 

M=N 

WRITE (6, 103) 

DO 1 I=1,M 
CALL HPACC(10@, 4, WORK,N, IWORK, TNODE, 1) 
WRITE(6,1@1) (TNODE(J), J=1,4) 
CALL HPDEL(1@@, 4, WORK,N, IWORK, LEFT) 

1 CONTINUE 


166 FORMAT (1X, 2E16. 8, 2110) 
101 FORMAT( 1X, 4E16. 8) 
102 FORMAT (16H QUAD. EST. 
LUCCESS=@ ) 
193 FORMAT(65H FINAL SUBINTERVALS...ERR EST, QUAD EST, 
Ll. END PT ) 
STOP 
END 


, 16H ERR. EST. 


L. END PT, 


LOGICAL FUNCTION LEFT(A, B,NCHAR) 
DIMENSION A(1), B(1) 


A TEST HEAP FUNCTION. 

THIS FUNCTION SETS LEFT = TRUE IF THE THIRD COMPONENT 
NODE A IS .LT. THE THIRD COMPONENT OF NODE B. 

FOR THE TEST PROBLEM THIS COMPONENT CONTAINS THE LEFT END- 
POINT OF THE INTERVAL DEFINED BY THE NODE. 


OF 


LEFT= A(3) 
RETURN 
END 


-LT. B(3) 


FUNCTION F(X) 
F=EXP (X) 
RETURN 

END 


FUNCTION G(X) 
G=1. /SQRT(X) 
RETURN 

END 


SUBROUTINE AGQ(A,B,F,EPS,Q,E,N,NMAX, XNODES ,T, IFLAG) 


1-D ADAPTIVE QUADRATURE-EXAMPLE USING HEAPS 


INPUT 
A, B = LIMITS OF INTEGRATION A.LT.B 
F = NAME OF USER SUPPLIED INTEGRAND FUNCTION, FUNCTION F(X) 
EPS = REQUESTED ABSOLUTE ACCURACY OF QUADRATURE 


NMAX = MAX NUMBER OF NODES ALLOWED 
XNODES = ARRAY FOR NODE STORAGE, DIMENSIONED AT LEAST 4*®NMAX 


T = INTEGER ARRAY USED INTERNALLY, DIMENSIONED AT LEAST NMAX 
OUTPUT 

Q = QUADRATURE ESTIMATE 

E = ERROR ESTIMATE 


N = NUMBER OF NODES REQUIRED FOR THE QUADRATURE 


MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 
MAIN 


,»1@H NO. INTS ,1@H SMAIN 


MAIN 


RTMAIN 


MAIN 
MAIN 
MAIN 


LEFT 
LEFT 
LEFT 
LEFT 
LEFT 
LEFT 
LEFT 
LEFT 
LEFT 
LEFT 
LEFT 
LEFT 


oy my 


QAaAan 


AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 


Pwr 


PWN Fe 


WOMAN DOF WNE 
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IFLAG = ERROR INDICATOR 
= @ PROGRAM APPARENTLY SUCCESSFUL 


EACH NODE IN THE HEAP REPRESENTS A SUBINTERVAL AND IS 


A FOUR WORD ARRAY. 
NODE(1) = ERROR ESTIMATE 
NODE(2) = QUADRATURE ESTIMATE 
NODE(3) = LEFT INTERVAL ENDPOINT 
NODE(4) = RIGHT INTERVAL ENDPOINT 


EXTERNAL GREATR, F 

LOGICAL GREATR 

REAL TNODE(4),N1(4),N2(4), XNODES (1) 
INTEGER T(1) 


CALL HPINIT(NMAX,N,T) 
CALL QINIT(TNODE, A,B) 
E=TNODE(1) 
Q=TNODE (2) 


INSERT INITIAL NODE 
CALL HPINS (NMAX, 4, XNODES ,N,T, TNODE, GREATR) 


IF(E .LE. EPS) RETURN 
CALL HPACC (NMAX, 4, XNODES,N, T, TNODE, 1) 
CALL HPDEL(NMAX, 4, XNODES, N, T, GREATR) 
CALL QSDVD(TNODE, N1, N2, F) 
CALL HPINS(NMAX, 4, XNODES,N, T,N1, GREATR) 
CALL HPINS(NMAX, 4, XNODES, N, T, N2, GREATR) 
E=E-TNODE (1)+N1(1)+N2(1) 
Q=Q-TNODE (2)+N1(2)+N2 (2) 
LFLAG=1 
IF(N .GE. NMAX-1) RETURN 
IFLAG=@ 
GO TO 1 

END 


SUBROUTINE QINIT(NODE, A, B) 


INITIALIZES THE FIRST INTERVAL TO A NODE BY SETTING THE 
ERROR ESTIMATE AND QUADRATURE ESTIMATE TO 10@@. AND @. RESP. 


REAL NODE(4) 
NODE(1)=160@. 
NODE (2)=@.0 
NODE (3)=A 
NODE (4)=B 
RETURN 

END 


SUBROUTINE QSDVD(NODE, R, L, F) 


SUBDIVIDES A NODE INTO TWO EQUAL HALVES. 

THE ENDPOINTS OF THE NEW NODES ARE COMPUTED HERE. THE ERROR 
AND QUADRATURE ESTIMATES FOR THE LEFT (L) AND RIGHT (R) 
HALVES ARE COMPUTED BY THE SUBROUTINE QUAD. 


EXTERNAL F 

REAL NODE(4),R(4),L(4) 
L(3)=NODE (3) 

R( 4) =NODE (4) 
L(4)=(L(3)+R(4)) /2. 
R(3)=L (4) 

CALL QUAD(L, F) 

CALL QUAD(R, F) 

RETURN 

END 


SUBROUTINE QUAD(NODE, F) 


ESTIMATES INTEGRAL OF F ON NODE USING 2 AND 3 POINT GAUSS. 


1 NODE STORAGE EXCEEDED, CALCULATION TERMINATED 


AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 
AGQ 


QINIT 
QINIT 
QINIT 
QINIT 
QINIT 
QINIT 
QINIT 
QINIT 
QINIT 
QINIT 
QINIT 
QINIT 


QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 
QSDVD 


QUAD 
QUAD 
QUAD 
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THE 3 POINT FORMULA GIVES ESTIMATE AND DIFFERENCE OF 2 AND 3 
GIVES ERROR ESTIMATE 


REAL NODE(4) 


XL= 


(NODE (4)-NODE(3))/2. 


XM= (NODE (4)+NODE(3))/2. 

Q2=XL* (F (XL* (—. 577350269 2)+XM) +F (XL* (.5773502692)+XM) ) 
Q3=XL* ((F(XL*(-. 7745966692 )+XM)+F (XL¥*(.7745966692)+XM) )/1. 8+ 
1 F(XM)/1.125) 

NODE (1)=ABS (Q2-Q3) 

NODE (2)=Q3 

RETURN 

END 


H E A P_ PACKAGE 
A COLLECTION OF PROGRAMS WHICH MAINTAIN A HEAP DATA 
STRUCTURE. BY CALLING THESE SUBROUTINES IT IS POSSIBLE TO 
INSERT, DELETE, AND ACCESS AN EXISTING HEAP OR TO BUILD A 
NEW HEAP FROM AN UNORDERED COLLECTION OF NODES. THE HEAP 
FUNCTION IS AN ARGUMENT TO THE SUBROUTINES ALLOWING VERY 
GENERAL ORGANIZATIONS. 

THE USER MUST DECIDE ON THE MAXIMUM NUMBER OF NODES 
ALLOWED AND DIMENSION THE REAL ARRAY DATA AND THE INTEGER 
ARRAY T USED INTERNALLY BY THE PACKAGE. THESE VARIABLES ARE 
THEN PASSED THROUGH THE CALL SEQUENCE BETWEEN THE HEAP 
PROGRAMS BUT ARE NOT IN GENERAL ACCESSED BY THE USER. HE 
MUST ALSO PROVIDE A HEAP FUNCTION WHOSE NAME MUST BE INCLUD- 
ED IN AN EXTERNAL STATEMENT IN THE USER PROGRAM WHICH CALLS 
THE HEAP SUBROUTINES. TWO SIMPLE HEAP FUNCTIONS ARE 
PROVIDED WITH THE PACKAGE. 


SUBROUTINE HPINIT(NMAX,N,T) 


PURPO 


SE 
THIS ROUTINE INITIALIZES THE HEAP PROGRAMS. 
IT IS CALLED ONCE AT THE START OF EACH NEW CALCULATION 


INPUT 
NMAX = MAXIMUM NUMBER OF NODES ALLOWED BY USER. 
OUTPUT 
N = CURRENT NUMBER OF NODES IN HEAP = @. 
T = INTEGER ARRAY OF POINTERS TO POTENTIAL HEAP NODES. 
INTEGER T(1) 
pO 1 I = 1, NMAX 
1 TC(L)=1 
N= 6 
RETURN 
END 


SUBROUTINE HPINS (NMAX, NCHAR, DATA,N,T,NODE, HPFUN) 


PURPO 


INPUT 


OUTPU 


SE 
THIS ROUTINE INSERTS A NODE INTO AN ALREADY EXISTING HEAP. 
THE RESULTING TREE IS RE-HEAPED. 


NMAX = MAXIMUM NUMBER OF NODES ALLOWED BY USER. 

NCHAR = NUMBER OF WORDS PER NODE. 

DATA = WORK AREA FOR STORING NODES. 

N = CURRENT NUMBER OF NODES IN THE TREE. 

T = INTEGER ARRAY OF POINTERS TO HEAP NODES. 

NODE = A REAL ARRAY, NCHAR WORDS LONG, WHICH 
CONTAINS THE NODAL INFORMATION TO BE INSERTED. 

HPFUN = NAME OF USER WRITTEN FUNCTION TO DETERMINE 
THE ROOT NODE. 

T 

DATA = WORK AREA WITH NEW NODE INSERTED. 

N UPDATED NUMBER OF NODES. 

T = UPDATED INTEGER POINTER ARRAY. 


DIMENSION T(1),NODE(1),DATA(1) 


REAL NODE 
INTEGER T 
LOGICAL HPFUN 


QUAD 4 
QUAD 5 
QUAD 6 
QUAD 7 
QUAD 8 
QUAD 9 
QUAD 1¢ 
QUAD 11 
QUAD 12 
QUAD 13 
QUAD 14 
QUAD 15 
QUAD 16 


HPINIT 
HPINIT 
HPINIT 
HPINIT 
HPINIT 
HPINIT 
HPINIT 
HPINIT 
HPINIT 
HPINIT10 
HPINIT11 
HPINIT12 
HPINIT13 
HPINIT14 
HPINIT15 
HPINIT16 
HPINIT17 
HPINIT18 
HPINIT19 
HPINIT2@ 
HPINIT21 
HPINIT22 
HPINIT23 
HPINIT24 
HPINIT25 
HPINIT26 
HPINIT27 
HPINIT28 
HPINIT29 
HPINIT3@ 
HPINIT31 
HP INIT 32 
HPINIT33 
HPINIT 34 


WOMAN NUP WNE 


HPINS 
HPINS 
HPINS 
HP INS 
HPINS 
HP INS 
HPINS 
HPINS 
HPINS 
HPINS 16 
HPINS 11 
HPINS 12 
HPINS 13 
HPINS 14 
HPINS 15 
HPINS 16 
HPINS 17 
HP INS 
HPINS 19 
HPINS 2¢ 
HPINS 21 
HPINS 22 
HPINS 23 
HPINS 24 
HPINS 25 
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IF(N .EQ. NMAX) RETURN 
N=N+1 
J= (T(N)-1)*NCHAR 
DO 1 I= 1,NCHAR 
IPJ=I+J 

1 DATA(IPJ) = NODE(I) 
J=N 

2 CONTINUE 
IF(J .EQ. 1) RETURN 
JT=T(J) 
J2=3/2 
JT2=T(J2) 
JL=(JT 2-1) *NCHAR+1 
JR=(JT-1)*NCHAR+1 
LF (HPFUN (DATA(JL), DATA(JR) ,NCHAR) ) RETURN 
T(J2)=T(J) 
T(J) =JT2 
J=J/2 
GO TO 2 
END 


SUBROUTINE HPBLD(NMAX, NCHAR, DATA, NELTS ,T,HPFUN) 


PURPOSE 
BUILDS A HEAP, IN T , FROM AN ARRAY OF NELTS ELEMENTS 
IN DATA, WHICH ARE SPACED NCHAR APART. 
AT CONCLUSION OF CALCULATION THE ROOT SATISFIES 
HPFUN (ROOT, SON) = .TRUE. FOR ANY SON. 
USES SUBROUTINE HPGRO BY FEEDING IT ONE ELEMENT OF 
THE ARRAY AT A TIME. 


INPUT 
NMAX = MAXIMUN NUMBER OF NODES ALLOWED BY USER. 
NCHAR = NUMBER OF WORDS PER NODE. 
DATA = WORK AREA IN WHICH THE NODES ARE STORED. 
NELTS = CURRENT NUMBER OF NODES. 
T = INTEGER ARRAY OF POINTERS TO HEAP NODES. 


HPFUN = NAME OF USER WRITTEN FUNCTION TO DETERMINE ROOT NODE. 


OUTPUT 
DATA = WORK AREA IN WHICH THE NODES ARE STORED. 
T = INTEGER ARRAY OF POINTERS TO HEAP NODES. 
IN PARTICULAR T(1) POINTS TO THE ROOT. 


EXTERNAL HPFUN 

LOGICAL HPFUN 

DIMENSION DATA(1) 

INTEGER T(1) 

IF(NMAX .LT. NELTS) RETURN 

INDEX = NELTS/2 

1 CONTINUE 

IF( INDEX .EQ. @) RETURN 
CALL HPGRO(NMAX, NCHAR, DATA, NELTS,T, HPFUN, INDEX) 
INDEX = INDEX-1 
GO TO 1 

END 


SUBROUTINE HPDEL (NMAX, NCHAR, DATA, NCELLS,T, HPFUN) 


PURPOSE 
DELETE ROOT ELEMENT OF HEAP. RESULTING TREE IS REHEAPED. 
INPUT 
NMAX = MAXIMUN NUMBER OF NODES ALLOWED BY USER. 
NCHAR = NUMBER OF WORDS PER NODE. 
DATA = WORK AREA IN WHICH THE NODES ARE STORED. 
NCELLS = CURRENT NUMBER OF NODES. 
T =-.INTEGER ARRAY OF POINTERS TO NODES. 


HPFUN = NAME OF USER WRITTEN FUNCTION TO DETERMINE ROOT NODE. 


OUTPUT 
NCELLS = UPDATED NUMBER OF NODES. 
T = UPDATED INTEGER POINTER ARRAY TO NODES. 


EXTERNAL HPFUN 
LOGICAL HPFUN 
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HPBLD 
HPBLD 
HPBLD 
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PURPOSE 


DIMENSION DATA(1) 

INTEGER T(1) 

IF(NCELLS .EQ. @) RETURN 

JUNK=T (1) 

T(1)=T(NCELLS) 

T(NCELLS )=JUNK 

NCELLS=NCELLS-1 

CALL HPGRO (NMAX, NCHAR, DATA, NCELLS, T, HPFUN, 1) 
RETURN 

END 


SUBROUTINE HPACC (NMAX, NCHAR, DATA,N,T,NODE,K) 


TO ACCESS THE K-TH NODE OF THE HEAP, 
1 .LE. K .LE. N .LE. NMAX 


INPUT 


NMAX = MAXIMUM NUMBER OF NODES ALLOWED BY USER. 

DATA = WORK AREA FOR STORING NODES. 

N = CURRENT NUMBER OF NODES IN THE HEAP. 

T = INTEGER ARRAY OF POINTERS TO HEAP NODES. 

NODE = A REAL ARRAY, NCHAR WORDS LONG, IN WHICH NODAL IN- 
FORMATION WILL BE INSERTED. 


K = THE INDEX OF THE NODE TO BE FOUND AND INSERTED INTO NODE. 


OUTPUT 


— 


NODE = A REAL ARRAY. CONTAINS IN NODE(1),...,NODE(NCHAR) 
THE ELEMENTS OF THE K-TH NODE. 


REAL DATA(1), NODE(1) 
INTEGER T(1) 
IF (K .LT. 1 .OR. K .GT. N .OR. N .GT. NMAX) RETURN 
J=(T (K)-1) *NCHAR 
DO 1 I=1,NCHAR 
IPJ=I+J 
NODE (1) =DATA(IPJ) 
RETURN 
END 


LOGICAL FUNCTION GREATR(A,B,NCHAR) 
REAL A(1),B(1) 

GREATR= A(1) .GT. B(1) 

RETURN 

END 


LOGICAL FUNCTION LESS (A,B, NCHAR) 
REAL A(1),B(1) 

LESS= A(1) .LT. B(1) 

RETURN 

END 


SUBROUTINE HPGRO(NMAX, KD, DATA, NELTS , T, HPFUN,KTEMP) 


PURPOSE 


FORMS A HEAP OUT OF A TREE. USED PRIVATELY BY HPBLD. 
THE ROOT OF THE TREE IS STORED IN LOCATION T(KTEMP). 
FIRST SON IS IN LOCATION T(2KTEMP), NEXT SON 

IS IN LOCATION T(2KTEMP+1). 

THIS PROGRAM ASSUMES EACH BRANCH OF THE TREE IS A HEAP. 


DIMENSION T(1),DATA(1) 
INTEGER T 

LOGICAL HPFUN 

IF(NELTS .GT. NMAX) RETURN 


K=KTEMP 
I=24K 


TEST IF ELEMENT IN I TH POSITION IS A LEAF. 


IF( I .GT. NELTS ) RETURN 
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IF THERE IS MORE THAN ONE SON, FIND WHICH SON IS SMALLEST. 


IF( I .EQ. NELTS ) GO TO 2 

ITEMP=T (1) 

ITP1=T(I+1) 

IL=(ITP1-1)*KD+1 

IR=(ITEMP~1) *KD+1 

IF (HPFUN (DATA(IL) , DATA(IR) ,KD)) I=I+1 


IF A SON IS LARGER THAN FATHER, INTERCHANGE 
THIS DESTROYS HEAP PROPERTY, SO MUST RE-HEAP REMAINING 
ELEMENTS 


CONTINUE 

KT=T (K) 

ITEMP=T (I) 

IL=(KT-1)*KD+1 

TR=(ITEMP~1)*KD+1 

IF (HPFUN (DATA(IL) , DATA(IR) ,KD)) RETURN 
ITEMP=T (1) 
T(1)=T(K) 
T(K)=ITEMP 
K=I 

Go TO 1 

END 
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ALGORITHM 562 
Shortest Path Lengths [H] 


U. PAPE 
Technische Universitat Berlin 


Key Words and Phrases: shortest path, shortest route problem 
CR Categories: 5.32 , 
Language: Fortran IV 


DESCRIPTION 


This algorithm finds the shortest path lengths from a specific node to all other 
nodes in a network. It is a modification of Moore’s algorithm [4], originally 
due to d’Esopo as reported by Pollack and Wiebenson [7] and refined by Pape 
[5, 6]. The algorithm does not determine the shortest paths. If a shortest path is 
to be determined, this algorithm may be combined with any algorithm that traces 
the shortest path from the root node to any other node from the list of predeces- 
sors of nodes. As the calculation of the path lengths is the most time-consuming 
part of the whole process, we confine our attention to this problem. 

The main idea of the given algorithm centers around the “status” of a new- 
found successor node /. If 7 has not yet been reached by the process, it is entered 
at the end of the successor list; if it is currently in the list, no new entry is made, 
but if it has already been processed and removed from the list, it is entered at the 
top of the list so that it will be processed next. The current status of each node 
is recorded by the values of the list which are stored as linked deque (double- 
ended queue). The steps involved are as follows: 


top element of the deque := 7; 
mj = ©; mj; = 0; 
while deque ¥ © do 
begin i := top element of the deque; 
remove top element; 
for all successors k of i do 
begin mk := mj; + diz 
if mjk < mj, then 
begin mj; := mjk; wj, := 1; 
if k has not yet been reached then enter & at the end of the deque; 
if k has already been processed then enter # at the top of the deque 
end 
end 
end; 


The great advantage of the above-mentioned technique is that errors in 
minimal distances are often corrected as soon as they are detected and not 
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allowed to progress further. In practice this leads to a considerable reduction in 
CPU time, particularly for grid networks. 

The additional bookkeeping work required costs less than the savings from the 
early processing of the nodes. This follows from a comparison of this technique 
with a more obvious strategy, where the deque is handled as a FIFO list (see 
[6}). 

The network N is represented by its forward star structure (see [3]) which is 
also used as input to the subroutine. This input consists of three arrays: the array 
KF, containing information about where the data for each node begin in the other 
two arrays; the array FList, containing the numbers of the nodes which can be 
reached directly from each node; and the integer array DF List, containing the 
distances to each of these nodes. 

The algorithm has been coded and tested in Algol 60, Algol-W, and Fortran IV 
for an IBM 370/158 (Berlin), an ICL 1907 (Braunschweig), and a CDC 6600 
(Austin). It has been tested on different networks, real transportation/road 
networks and random road networks, constructed by network generators devel- 
oped at Berlin and Austin. Independently, a variant of this algorithm has been 
tested at the Institute for Transportation Studies at the University of Leeds [8]. 
It has been compared with several versions of Dijkstra’s algorithm [2] (with 
different binary tree structures for the nodes to be discussed), particularly Dial’s 
algorithm [1]. The investigations have shown that the algorithm, based on 
d’Esopo’s idea, is generally the most efficient in terrns of CPU times (and core 
storage) for a large variety of networks. The code is highly insensitive to the 
magnitude of the distance measures. 
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INTEGER FLIST (200) , DFLIST (206) ,KF(51) ,MJ (50) ,WJ (50) ,W(5@) ,H(50), 
IN, INPUT, OUTP , TEMP (10) 


THIS PROGRAM CALCULATES THE SHORTEST PATH LENGTHS FROM A SPECIFIC 
NODE (J@) TO ALL OTHER NODES IN A NETWORK AND THE SHORTEST PATHS 
BETWEEN THIS NODE (J@) AND OTHER NODES (KE). 


FLIST(NUMBER OF EDGES) 
DFLIST (NUMBER OF EDGES) 
KF (NUMBER OF NODES+1) 


FLIST, DFLIST, AND KF REPRESENT THE NETWORK 


PAP OG9O1 
PAPOOOO2Z 
PAP GOOO3 
PAPOOGO4 
PAP OOOO5 
PAP OOOO6 
PAP OOOO7 
PAPOOOO8 
PAP OOPOS 
PAPGO616 
PAPOOO11 
PAPGQG12 
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MJ (NUMBER OF NODES) 
WJ (NUMBER OF NODES) 
W(NUMBER OF NODES) 
H(NUMBER OF NODES) 


DATA INF,IN, INPUT,OUTP /100000¢, 4,5, 6/ 


IN CHANNEL FOR INPUT J@ 
INPUT CHANNEL FOR INPUT NETWORK 
OUTP CHANNEL FOR OUTPUT 


INPUT OF THE NUMBER OF NODES N 


READ (INPUT, 140) N 
K=@ 
KF (1)=@ 


INPUT OF THE NETWORK 


DO 4 I=1,N 

READ (INPUT,1@0) IT, (TEMP (J),J=1,1T) 
IF (IT.EQ.@) GO TO 3 

JA=K+1 

JB=K+IT 

JJ=1. 

pO 2 J=JA,JB 

FLIST (J) =TEMP (JJ) 

JJ=JI+1 


READ (INPUT, 140) IDUMMY, (DFLIST(J) ,J=JA,JB) 
K=K+1T 

KF (I+1)=K 

CONTINUE 


INPUT OF START NODE J@ 


READ(IN, 1061) J@ 
IF (J@.LE.@) STOP 


CALL SHPTHL(FLIST, DFLIST,KF,N,MJ ,J@, WJ) 


WRITE (OUTP,20@) J@ 
IF (N.GT.@) WRITE(OUTP, 201) (1,MJ(1I) ,I=1,N) 


INPUT OF END NODE KE 


READ(IN,1@1) KE 
IF (KE.LE.@) GO TO 5 


CALL SHPATH(J@, KE, WJ ,H,NI,W) 


WRITE (OUTP, 202) J@,KE,MJ (KE) 
WRITE(OUTP,203) (W(I),I=1, NI) 
GO TO 6 


FORMAT (1018) 

FORMAT (14) 

FORMAT (21H1IDISTANCES FROM NODE ,15/) 
FORMAT (1@(17,1H-,14)) 


FORMAT (//15H PATH FROM NODE,17,9H TO NODE ,17,13H (PATHLENGTH=, 


+ 17, 1H)) 


FORMAT(1H , 2016) 
END 


SUBROUTINE SHPTHL(FLIST, DFLIST,KF,N,MJ ,J@, WJ) 
INTEGER FLIST( 2060) , DFLIST (260) ,KF(51) ,MJ (50) ,NJ (50) ,WJ (50) 


DATA INF /1000000/ 


SHPTHL CALCULATES THE SHORTEST PATH LENGTHS (MJ) FROM A SPECIFIC 
NODE (J@) TO ALL OTHER (N-1) NODES IN A NETWORK (FLIST,DFLIST,KF) 


PREDECESSOR NODES ARE STORED IN WJ. 


FLIST : FORWARD INDEX LIST 
DFLIST: DISTANCE LIST 


PAPOOO13 
PAPOQO14 
PAPOO@15 
PAPGOO16 
PAPGGG17 
PAP OG018 
PAPOGG19 
PAPGOGO20 
PAP QGO21 
PAPGOG22 
PAPG0023 
PAP@O024 
PAPQO@25 
PAPOOG26 
PAP GG@27 
PAPOOG28 
PAPGGO29 
PAP 90030 
PAPGOO31 
PAPGOG32 
PAPG9033 
PAP OOO 34 
PAPG0035 
PAP G0036 
PAP Q0037 
PAP 00038 
PAP $0039 
PAPOOO4O 
PAPOOO41 
PAPGOO42 
PAPQO043 
PAP 06044 
PAP OOO45 
PAPQO046 
PAPO0@47 
PAPGGO48 
PAPQOO49 
PAPOOO50 
PAP QOO51 
PAPGO0O52 
PAPOOO53 
PAPGOO54 
PAPGO055 
PAPOOO56 
PAPG@@57 
PAP @0658 
PAP G0059 
PAPOOO60 
PAPOOO6L 
PAP 600662 
PAP OGG63 
PAP OGO64 
PAP QO@65 
PAP O0066 
PAP OOQ67 
PAPGG068 
PAPOGO69 
PAP GO070 
PAPOGO71 
PAP GOO 72 
PAP 00073 
PAP GO074 
PAPQ0075 
PAPOOO76 


SPLOOGG1 
SPLOOOG2 
SPLO90063 
SPLOOOD4 
SPLOOG05 


. SPLO9006 


SPL0GO07 
SPLGGOO8 
SPLOGOO9 
SPLOGG10 
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KF : POINTER LIST FOR FLIST AND DFLIST 

N : NUMBER OF NODES 

MJ : ARRAY OF SHORTEST PATH LENGTHS 

JO : INITIAL NODE, FIRST NODE OF SHORTEST PATH 

WJ : ARRAY OF PREDECESSORS FOR SHORTEST PATH CONSTRUCTION 
NJ : DOUBLE ENDED QUEUE FOR NODE DISCUSSION 

INF : A LARGE NUMBER 


INITIAL VALUES OF 


FLIST,DFLIST,KF: NETWORK FROM INPUT AND MAIN PROGRAM 


N : NUMBER OF NODES FROM INPUT AND MAIN PROGRAM 

Jo : START NODE FROM INPUT AND MAIN PROGRAM 

pC 1 I=1,N 

MJ (I)=INF 

NJ(1)=0 

MJ (JO) =0 

I : INDEX FOR NODE DISCUSSION, NODE UNDER DISCUSSION 

NT : POINTER TO THE END OF DEQUE NJ 

MJI : LOCAL VARIABLE OF MJ(I) 

KFI  : LOCAL VARIABLE OF KF(1) 

KFI1 : LOCAL VARIABLE OF KF(1I)+1 

IR : INDEX FOR ARRAY DISCUSSION 

K : SUCCESSOR OF NODE I 

MJK : LOCAL VARIABLE OF MJ(K) 

NJI : LOCAL VARIABLE OF NJ(1), THE NEXT NODE OF NJ TO BE TAKEN 
UNDER DISCUSSION 

NJ (J@)=INF 

I=J@ 

NT=J@ 

OUTER LOOP 


DISCUSSION OF NODES I 


KFI=KF (I+1) 
MJI=MJ (1) 
KFI1=KF(1I)+1 


INNER LOOP 
DISCUSSION OF SUCCESSORS K 


IF (KFI1.GT.KFI) GO TO 6 

DO 5 IR=KFI1,KFI 

K=FLIST (IR) 

MJK=MJI+DFLIST (IR) 

NO DECREASE OF SHORTEST DISTANCES 

IF (MJK.GE.MJ(K)) GO TO 5 

DECREASE OF SHORTEST DISTANCES 

MJ (K) =MJK 

PREDECESSOR I OF NODE K 

WJ (K)=I 

NODE K ALREADY IN THE DEQUE NJ ? 

IF (NJ(K)) 4,3,5 

NODE K ADDED AT THE END OF THE DEQUE NJ 
NJ (NT) =K 

NT=K 

NJ (K)=INF 

GO TQ 5 

NODE K ADDED AT THE BEGINNING OF THE DEQUE NJ 
NJ (K)=NJ (1) 

NJ(1)=K 

CONTINUE 

NODE I TAKEN FROM THE BEGINNING OF THE DEQUE NJ 
NJI=NJ (1) 

NJ (1)=-NJI 

I=NJI 

IF (I.LT.INF) GOTO 2 

RETURN 

END 


SUBROUTINE SHPATH(J@, KE, WJ ,H,NI,W) 
INTEGER WJ (56) ,H(5@) ,W(50) 


SPLOG@11 
SPLGOG12 
SPL00013 
SPLOOO14 
SPLQOO15 
SPLOOO16 
SPLOOO17 
SPLGOG18 
SPLOGG19 
SPLOOO?2H 
SPLQOO21 
SPLOOG22 
SPLGOO23 
SPLOGO24 
SPLGO025 
SPLGOO26 
SPLOGO27 
SPLOOO28 
SPLOGG29 
SPLOOO30 
SPLO00631 
SPLOGO32 
SPL00033 
SPLOGO34 
SPL@0035 
SPLO60636 
SPLQOO37 
SPLOO038 
SPLO0039 
SPLOOO4O 
SPLOOO41 
SPLOO042 
SPLOOO4 3 
SPLOGO44 
SPLOOO45 
SPLO0046 
SPLOOO47 
SPLO9O48 
SPLOOO49 
SPLOOG50 
SPLOOO51 
SPLOO@52 
SPLOOO53 
SPLOGO54 
SPLO06655 
SPLQOO56 
SPLOOO57 
SPLOOO58 
SPL0OO59 
SPLOOO6O 
SPLOOO61 
SPLGOG62 
SPLO0063 
SPLOOO64 
SPLO@G65 
SPL@GO66 
SPLOOO67 
SPLOOG68 
SPLOOG69 
SPLOOO70 
SPLOO671 
SPLOGO72 
SPL0OO73 
SPLOOG674 
SPLO0075 
SPLOOO76 
SPLO0077 
SPLOO078 
SPL00O079 
SPL@9OG8¢ 
SPL@GO81 


PATOOOO1L 
PATOOGD2 
PATOGOO3 
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SHPATH CALCULATES THE SHORTEST PATH BETWEEN THE TWO NODES J@ AND 
KE. SHPATH USES THE INFORMATION IN WJ, THE LIST OF PREDECESSOR 


NODES. THE NODES OF THE SHORTEST PATH ARE STORED IN W. 


Jo 
KE 


I,J 


INITIAL 
J@ 
KE : 
WJ 


H(1)=KE 
I=1 
J=KE 


: FIRST NODE OF THE SHORTEST PATH 

: LAST NODE OF THE SHORTEST PATH 

: ARRAY OF PREDECESSORS FOR SHORTEST PATH CONSTRUCTION 
: AUXILIARY ARRAY FOR THE SHORTEST PATH 

: NUMBER OF NODES OF THE SHORTEST PATH 

: THE SHORTEST PATH 


: LOCAL VARIABLE FOR NODE DISCUSSION 


VALUES OF 


: FIRST NODE FROM INPUT OR MAIN PROGRAM 


LAST NODE FROM INPUT OR MAIN PROGRAM 


: FROM SUBROUTINE SHPTHL 


IF (J@.EQ.KE) GO TO 2 


I=I+1 
J=WJ (J) 
H(I)=J 


IF (J.NE.J@) GO TO 1 


NI=I 


pO 3 I=1,NI 
W(1)=H(NI+1-1) 


RETURN 
END 


PATOOGD4 
PATOOOO5 
PATOOOO6 
PATQGOO7 
PATOOGO8 
PATOOODI 
PATOOG10 
PATOO@11 
PATOOG12 
PAT@0013 
PAT@OO14 
PATOOO15 
PAT OOO16 
PATQOO17 
PATOOO18 
PATOOG19 
PATOOG20 
PATOOG21 
PAT @OO22 
PATOOO23 
PATGQG24 
PATOOO25 
PATGOO26 
PATOOO27 
PATGOO28 
PATOGG29 
PATGOO30 
PAT@OO31 
PATOG@32 
PATOOO33 
PATOOO34 
PAT 90035 
PAT 00036 
PAT 960637 
PATOO9O38 
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ALGORITHM 563 
A Program for Linearly Constrained 
Discrete /, Problems 


RICHARD H. BARTELS and ANDREW R. CONN 
The University of Waterloo 


Key Words and Phrases: numerical analysis, overdetermined linear systems, linear constraints, 
discrete /, approximation 

CR Categories: 5.13, 5.41 

Language: Fortran 


DESCRIPTION 


The subroutine CL1 given here is a complement of [1], where the theoretical 
development appears. 


REFERENCES 


1. BARTELS, R.H., AND Conn, A.R. Linearly constrained discrete J; problems. ACM Trans. Math 
Softw. 6, 4 (Dec. 1980), 594-608. 


ALGORITHM 


{Summary information and a part of the listing are printed here. The complete 
listing is available from the ACM Algorithms Distribution Service.] 


NAME(n): indicates a Fortran module with n records 

NAME'(n): indicates “NAME” is included for testing purposes 

NAME?(n): indicates “NAME” contains test data 

Contents; MAIN™(100), DATFL1"(65), DATFL2"(104), CL1(344), 
SETUP(108), NEWPEN(57), UPDATE(52), MONIT(49), 
FINDP(175), STEP(144), REFINE(48), DELCOL(51), 
RESID(108), ADDCOL(70), OBJECT(72), GETV(91), 
DKHEAP(108), UNIF01(88), ZDRCIN(164), ZDRCOU(166), 
ZDRGIT(151), ZDRGNV(139), ZDRPOC(143), SASUM(69), 
SAXPY (55), SCOP Y (58), SDOT (54), SROTM(109), 
SROTMG(181), SSCAL(41), DATAO?(446) 


SUBROUTINE CL1(NEQNS ,NEQC,NIQC,NVARS ,NACT, LFL, MXS,PSW, CL10269@ 

* E, NER, X,F, ELIN, RES, INDX,W) CL162700 

Cc CL1$2710 
INTEGER IFL, INDX(1),MXS, NACT,NEQC, NEQNS, NER, NIQC,NVARS CL102720 
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LOGICAL PSW 
REAL E(NER,1),ELIN, F(1), RES(1) ,W(1),X(1) 


RHRKRKRKK AK KKK KERR RR REE KK RRR RR EER RR RRER ERA RR ERERERERERER 
A PROGRAM FOR THE SOLUTION IN THE Ll SENSE 

OF A LINEAR-EQUATION SYSTEM 

(WITH OR WITHOUT LINEAR CONSTRAINTS). 

RICHARD H. BARTELS AND ANDREW R. CONN. 

LATEST UPDATE .... 13 APRIL, 198@. 


DEVELOPMENT OF THIS PROGRAM WAS SUPPORTED 

IN PART BY U. S. NSF GRANT DCR75-67817 

AND BY FUNDS FROM THE NATIONAL BUREAU OF STANDARDS, 
AND IN PART BY CANADIAN NRC GRANT A8639. 


+H+-+++ PARAMETERS +++++ 


INPUT 
NAME TYPE SUBSCRPT OUTPUT DESCRIPTION 
SCRATCH 
NEQNS INT. NONE IN NUMBER OF EQUATIONS 
(MAY BE ZERO) 
NEQC INT. NONE IN NUMBER OF EQUALITY 
CONSTRAINTS 
(MAY BE ZERO) 
NIQC INT. NONE IN NUMBER OF INEQUALITY 
CONSTRAINTS 
(MAY BE ZERO) 
NVARS INT. NONE IN NUMBER OF VARIABLES 
NACT INT. NONE OUT NUMBER OF ACTIVE 
EQUATIONS/ CONSTRAINTS 
AT TERMINATION 
(IF ANY, THEIR ASSOCIATED 
COLUMN POSITIONS IN E WILL 
BE LISTED IN INDX(1) 
THROUGH INDX(NACT) ) 
IFL INT. NONE OUT TERMINATION CCDE 
(SEE BELOW) 
MXS INT. NONE IN MAXIMUM NUMBER OF STEPS 
ALLOWED 
PSW LOGIC. NONE IN PRINT SWITCH 
(SEE BELOW) 
E REAL 2 IN EQUATION/CONSTRAINT MATRIX 
THE FIRST NECNS COLUMNS 
(SEE NOTE BELCW) SPECIFY 
EQUATIONS, THE REMAINING 
COLUMNS (IF ANY) SPECIFY 
CONSTRAINTS. 
NER INT. NONE IN ROW DIMENSION OF E 
xX REAL 1 IN STARTING VALUES FOR THE 
UNKNOWNS (USE ZEROS IF NO 
GUESS IS AVAILABLE) 
OUT TERMINATION VALUES FOR 
THE UNKNOWNS 
F REAL 1 IN EQUATION/CONSTRAINT 
RIGHT-HAND SIDES 
ELIN REAL NONE OUT L1 NORM OF EQUATION 
RESIDUALS AT TERMINATION 
RES REAL 1 OUT EQUATION /CONSTRAINT 


RESIDUALS AT TERMINATION 


CL19$2730 
CL10274¢ 
CL16275@ 
CL10276¢@ 
CL10277¢ 
CL196278¢ 
CL162790 
CL102806 
CL16281¢ 
CL10282¢ 
CL10283@ 
CL106284@ 
CL1028506 
CL102860 
CL1902870 
CL14288@ 
CL19289¢ 
CL10290¢ 
CL102910 
CL19292¢ 
CL102936 
CL162940 
CL162950 
CL190296¢ 
CL19$297¢ 
CL162980 
CL102996 
CL103000 
CL1963010 
CL103020 
CL103036 
CL14630640 
CL14630506 
CL103060 
CL163076 
CL1630680 
CL1963096 
CL103160 
CL106311¢ 
CL10312¢ 
CL103130 
CL193146 
CL103156 
CL19631606 
CL143170 
CL103180 
CL1963190 
CL103206 
CL103216 
CL163220 
CL10323@ 
CL10324@ 
CL14325¢6 
CL103260 
CL16327@ 
CL1$328¢@ 
C1.163296 
CL103300@ 
CL103310 
CL106332@ 
CL10333@ 
CL19334¢ 
CL10335@ 
CL103360 
CL103370 
CL193380 
CL193390 
CL103400 
CL193410 
CL193420 
CL1903430 
CL10344@ 
CL10345@ 
CL16346@ 
CL103470 
CL103480 
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INDX INT. 1 OUT INDEX VECTOR USED TO RECORD 
THE ORDER IN WHICH THE COLUMNS 
OF E ARE BEINC PROCESSED 

W REAL 1 SCR WORKING STORAGE : 


a ee cr ce es wi i ew cs a a a cre a a es es ae te a ee ec ce oe en ee es ee 


THIS SUBROUTINE SOLVES THE NEQNS BY NVARS 
SYSTEM OF EQUATIONS 


(A-TRANSPOSE) * X == B 
SUBJECT TO THE NEQC CONSTRAINTS 
(G-TRANSPOSE) * X .EQ. H 
AND THE NIQC INEQUALITY CONSTRAINTS 

(C-TRANSPOSE) * X .GE. D 
FOR THE UNKNOWNS X(1),...,X(NVARS). 


THE PROBLEM MUST BE WELL-POSED, NONTRIVIAL 
AND OVERDETERMINED IN THE SENSE THAT 


NVARS 
NEQNS 
NEQC 
NIQC 
NEQNS+NEQC+NIQC 


CEs 1 
.GE. @ 
.GE. 6 
.GE. @ 
.GE. NVARS. 


FURTHER, NO COLUMN OF A, G OR C SHOULD BE ZERO. 
IF THESE CONDITIONS ARE NOT MET, THE PROGRAM 

WILL TERMINATE WITHOUT PERFORMING ANY SUBSTANTIVE 
COMPUTATIONS. 


A POINT X IS A SOLUTION IF IT MINIMIZES THE EQUATION 
RESIDUALS FROM AMONG ALL POINTS WHICH SATISFY THE 
CONSTRAINTS. AT ANY (NONDEGENERATE) SOLUTION 

THERE WILL BE NACT EQUATIONS AND CONSTRAINTS 

WHOSE RESIDUALS 


(A(I)-TRANSPOSE) * X - B(I) 


(G(I)-TRANSPOSE) * X - H(I) 


(C(I)-TRANSPOSE) * X - D(I) 
ARE ZERO. 


THE COLUMNS OF (A,G,C) CORRESPONDING TO THE ZERO RESIDUALS 
ARE REFERRED TO AS ACTIVE COLUMNS THROUGHOUT THIS LISTING. 
THE NUMBERS OF THE ACTIVE COLUMNS ARE MAINTAINED AS THE 
ENTRIES 1,...,NACT OF THE ARRAY INDX. 


A SOLUTION X IS FOUND BY MINIMIZING A PIECEWISE 
LINEAR PENALTY FUNCTION FORMED FROM THE L1 

NORM OF THE EQUATION RESIDUALS AND THE SUM OF THE 
INFEASIBILITIES IN THE CONSTRAINTS. 

THE MINIMIZATION PROCEEDS IN A STEP-BY-STEP 

FASHION, TERMINATING AFTER A FINITE NUMBER OF STEPS. 


NOTE THAT A, G AND C APPEAR TRANSPOSED IN THE 
PROBLEM FORMULATION. HENCE IT IS THE COLUMNS OF (A4,G,C) 
WHICH DEFINE THE EQUATIONS AND CONSTRAINTS RESPECTIVELY. 


THE ARRAY E IS A COMPOSITE OF A, G AND C 

AND F IS A COMPOSITE OF B, H AND OD. 

E SHOULD CONTAIN A AS ITS FIRST NEQNS COLUMNS. 
IT SHOULD CONTAIN G AS ITS NEXT NEQC COLUMNS AND 
CONTAIN C AS ITS REMAINING NIQC COLUMNS. 
SIMILARLY F SHOULD CONTAIN B AS ITS FIRST 


CL16349@ 
CL103506 
CL193516 
CL196352¢ 
CL103530 
CL103540 
CL16355@ 
CL163560 
CL16357@ 
CL163580 
CL10359¢ 
CL103600 
CL103610 
CL193620 
CL10363@ 
CL10364¢ 
CL19365@ 
CL193660 
CL103670 
CL10368¢ 
CL103690 
CL103760 
CL103710@ 
CL103720 
CL193730@ 
CL146374¢ 
CL103750@ 
CL163760 
CL163770 
CL1403780 
CL16379@ 
CL163800 
CL103810 
CL10382¢ 
CL1903830 
CL16384@ 
CL193850 
CL16386@ 
CL103876 
CL16388¢ 
CL163890 
CL10390¢ 
CL103910 
CL146392@ 
CL10393¢ 
CL103940 
CL163950 
CL16396¢@ 
CL10397@ 
CL103980 
CL163999 
CL164000 
CL16461¢ 
CL1940620 
CL104630 
CL10464@ 
CL104050 
CL1640660 
CL1044670 
CL10468¢ 
CL104696 
CL10410@ 
CL1064110 
CL10412¢ 
CL10413¢ 
CL19414@ 
CL194150 
CL1904160 
CL10417@ 
CL19418¢ 
CL10419¢ 
CL194200 
CL10421¢ 
CL164226 
CL19$423@ 
CL16424@ 
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io} 


TOL OOOAOAAARAAMAAAAAAAAMANAAn 


NEQNS COMPONENTS, H AS ITS NEXT NEQC COMPONENTS 
AND D AS ITS LAST NIQC COMPONENTS. 


E IS TO BE DIMENSIONED AT LEAST N BY 4M, 


x AT LEAST N, 
F AT LEAST  ¥, 
RES AT LEAST  M, 
INDX AT LEASE M 


W AT LEAST (( 3*N*N+114N+2)/2) + (24M). 


WHERE N = NVARS AND 
M = NEQNS+NEQC+NIQC 


ee ee re ae ee Oe SS eS A OS SS SE NS AS A ES CS A 


THE USER MUST INITIALIZE 
NEQNS ,NEQC,NIQC,NVARS ,MXS,PSW,E,NER,X,F . 


THE FOLLOWING ARE SET BY CL1 
AND DO NOT REQUIRE INITIALIZATION 


NACT, INDX, RES 


THE ARRAY W IS USED AS SCRATCH SPACE. 


me re ce er ne ce net me tes cae ee ee ce ee ee ee ee ee ee ee oe ee ee ee 


+++++ TEPMINATION CODES AND INTERMEDIATE PRINTING +++++ 


a ee ee ee ae ee ee ee re ee ae a ee a a ee a a ee 


MXS SETS A LIMIT ON THE NUMBER OF MINIMIZATION STEPS TO BE 
TAKEN, 


UPON TERMINATION IFL WILL BE SET ACCORDING TO 
THE FOLLOWING CODE ... 


IFL = 1 .... SUCCESSFUL TERMINATION. 

IFL = 2 .... UNSUCCESSFUI, TERMINATION. 
CONSTRAINTS CANNOT BE SATISFIED. 
PROBLEM IS INFEASIBLE. 

IFL = 3..... LIMIT IMPOSED BY MXS REACHED 
WITHOUT FINDING A SOLUTION. 

IFL = 4 .... PROGRAM ABORTED. 
NUMERICAL DIFFICULTIES 
DUE TO ILL-CONDITIONING. 

IFL = 5 .... NEQNS, NVARS, NEQC AND/OR 


NIQC HAVE IMPROPER VALUES 
OR E CONTAINS A ZERO COLUMN. 


IN ALL CASES THE OUTPUT PARAMETERS X,ELIN AND RES 
WILL CONTAIN THE VALUES WHICH THEY REACHED AT TERMINATION. 


INTERMEDIATE PRINTING WILL BE TURNED OFF IF PSW = .FALSE. 
ON THE OTHER HAND, DETAILS OF EACH MINIMIZATION CYCLE 
WILL BE PRINTED IF PSW IS SET TO .TRUE. 


Se ee Ce eS SE SS ee EE SSS cS mS tS 


+++ REMARKS AND USER CAUTIONS +++++ 

1. BEYOND SOME PRECAUTIONARY STEPS TAKEN IN 
CERTAIN DIVISIONS, NO SPECIAL 
OVERFLOW/UNDERFLOW PROTECTION IS PROVIDED. 

2. ALL TOLERANCES FOR CHECKING ZEROS AND LINEAR 
DEPENDENCIES ARE DETERMINED FROM THE QUANTITY 
EPS WHICH APPEARS IN DATA DECLARATIONS IN CL1 
AND SEVERAL OF ITS SUBROUTINES. EPS CAN BE SET TO THE 
LEAST POSITIVE NUMBER SATISFYING (1.0 + EPS) .GT. 1.0 
IN THE PRECISION OF ARITHMETIC BEING USED. WITH THIS 
SETTING, CLi USES AN EXTREMELY STRICT ZERO TOLERANCE. 


CL16425¢ 
CL1$426¢@ 
CL104270 
CL10428¢ 
CL194290 
CL104300 
C1L104310 
CL164326 
CL104330 
CL16434¢ 
CL10435¢ 
CL10436¢ 
CL164376 
CL10438¢ 
CL16439¢ 
CL16440@ 
CL10441¢ 
CL10442¢ 
CL16443@ 
CL194440 
CL19$44506 
CL19446¢ 
CL10447¢ 
CL16448¢@ 
CL104496@ 
CL10450¢ 
CL19451¢ 
CL10452¢ 
CL10453¢ 
CL10454@ 
CL104550@ 
CL1645606 
CL104570 
CL164580@ 
CL10459¢ 
CL10460@ 
CL1$461¢ 
CL10462¢ 
CL104630 
CL16464@ 
CL10465@ 
CL1$466¢@ 
CL10467¢ 
CL104686 
CL104696 
CL104706 
CL10471¢ 
CL164720 
CL104730 
CL104740 
CL16475@ 
CL16476@ 
CL16477@ 
CI.10478@ 
CL10479@ 
CL10480¢ 
CL10481@ 
CL194820 
CL19483¢ 
CL10484¢ 
CL10485¢@ 
CL10486¢ 
CL164870 
CL194886 
CL16489¢ 
CL104900 
CL104910 
CL19492¢ 
CL19493@ 
CL10494@ 
CL19495¢ 
CL10496¢ 
CL16497¢ 
CL19498¢@ 
CL10499¢@ 
CL195000 
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FOR A MORE FORGIVING VERSION OF CL1, EPS MAY BE REMOVED 
FROM THE DATA DEFINITIONS AND INCLUDED AS A USER-SPECIFIED 
ZEPO-TESTING PARAMETER IN THE ARGUMENT LIST. IN SUCH AN 
EVENT, IF THE PROBLEM DATA IS GIVEN TO NDIG SIGNIFICANT 
DIGITS, THEN 16.@**(-NDIG) IS A REASONABLE CHOICE 
FOR THE VALUE OF EPS. 
OVERFLOW CHECKING PRIOR TO DIVISION IS 
DONE USING THE QUANTITY BIG, ALSO SPECIFIED AS DATA. 
BIG SHOULD BE THE LARGEST REPRESENTABLE FLOATING 
POINT NUMBER. 
THIS IS A SINGLE PRECISION VERSION OF CLI. 
TO CHANGE THIS CODE INTO DOUBLE PRECISION ... 
A. CHANGE ALL OCCURRENCES OF —- REAL - 
DECLARATIONS TO - DOUBLE PRECISION - 
B. CHANGE ALL OCCURRENCES OF - SYSTEM ROUTINES - 
(AS LISTED IN THE HEADING OF EACH SUBROUTINE) 
TO THEIR CORRESPONDING DOUBLE PRECISION VERSIONS 
C. CHANGE ALL OCCURRENCES OF THE STRINGS E+ AND E- 
TO D+ AND D- RESPECTIVELY 
D. CHANGE ALL BASIC LINEAR ALGEBRA ROUTINES 
TO THEIR DOUBLE-PRECISION EQUIVALENTS 
E. BOTH EPS AND BIG WILL, HAVE TO BE CHANGED 
TO THEIR DOUBLE PRECISION EQUIVALENTS 
F. THE REFERENCES TO - IFIX - IN SUBROUTINES 
- RESID - AND - GETV - MUST BE CHANGED 
FROM THE FORM 
IFIX (FLOAT (K) *UNIF(...)) 
TO THE FORM 
IFIX (FLOAT (K) *SNGL(UNIF(...))) 
G. THE REFERENCE TO - FLOAT - IN SUBROUTINE 


(BLAS) 


~ RESID - MUST BE CHANGED FROM THE FORM 
FLOAT (...) 
TO THE FORM 


DBLE(FLOAT(...)) 


H. REMOVE THESE COMMENT CARDS (3., 3.A.7-3.H.). 


ee ee a a a et ee ee a a we a a a a a a ne a ee re = 


CL165¢10 
CL105020 
CL19503@ 
CL10504@ 
CL105050 
CL1¢566¢6 
CL10507@ 
CL16508@ 
CL145490 
CL165140 
CL1945110 
CL105120 
CL10513@ 
CL19514@ 
CL105150 
CL10516@ 
CL105170 
CL105180 
CL16519@ 
CL16520@ 
CL1@5210@ 
CL10522@ 
CL10523@ 
CL105249 
CL105250 
CL16526@ 
CL165270 
C1.165280 
CL165290 
CL105 300 
CL105310 
CL165326 
CL10533@ 
CL10534@ 
CL195350 
CL105360 
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Editor’s Note 


Owing to the increasing length of algorithms accepted for publication in ACM 
Transactions, it has become impractical to supply lengths of individual proce- 
dures. Instead, lengths of entire algorithms are given on the Algorithms order 
form. 


ALGORITHM 564 
A Test Problem Generator for Discrete 
Linear L, Approximation Problems 


K.L. HOFFMAN and D.R. SHIER 
National Bureau of Standards 


Key Words and Phrases: L; approximation, least absolute deviation, problem generator, test data 
CR Categories: 5.13, 5.41, 5.5 
Language: Fortran 


DESCRIPTION 


The algorithm given here is a complement to [1], where its theoretical develop- 
ment and implementation are described. 


REFERENCES 
1. HorrMaN, K.L., AND SHIER, D.R. A test problem generator for discrete linear Li approximation 
problems. ACM Trans. Math. Softw. 6, 4 (Dec. 1980), 587-593. 


ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service. ] 


DESCRIPTION: 


THIS SUBROUTINE GENERATES DATA SETS WHICH CAN BE 
USED FOR TESTING L1-APPROXIMATION (LEAST ABSOLUTE 
DEVIATION CURVE-FITTING) COMPUTER CODES. THE USER 
CAN SPECIFY 


PROBLEM SIZE 

SOLUTION VFCTOR 

STATISTICAL DISTRIBUTION FOR COLUMN ELEMENTS 
ROW REPETITIONS 

DEGENERACY 

RANK LOSS 

STATISTICAL DISTRIBUTION FOR RESIDUALS 


e+ ee FF He EF 


Cc 
C 
Cc 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
Cc 
C 
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ON OUTPUT, X = XOPT IS AN OPTIMAL SOLUTION TO THE 
GENERATED L1-APPROXIMATION PROBL=M: 


MINIMIZE // X*A - RHS // , 


WHERE //...// IS THE L1-NORM AND THE TRANSPOSE OF 
A REPRESENTS THE DESIGN MATRIX. FURTHERMORE, 

X = XOPT IS GUARANTEED TO BE THE UNIQUE OPTIMAL 
SOLUTION IF RLOSS=@. 


INPUT ARGUMENTS: 


NOBS --— NUMBER OF OBSERVATIONS 
NPAR -- NUMBER OF PARAMETERS 
NXGEN -- INDICATES WHETHER SOLUTION X IS SPECIFIED 
AS INPUT OR GENERATED 
= @ IF SPECIFIED AS INPUT 
1 IF RANDOMLY GENFRATED FROM NORMAL 
2 IF RANDOMLY GENERATED FROM UNIFORM 
XOPT -~- REAL ARRAY OF DIMENSION NPAR - RLOSS WHICH 
SPECIFIES THE OPTIMAL SCLUTION IF NXGEN IS 
SET EQUAL TO ZERO 
XMEAN -- MEAN OF NORMAL DISTRIBUTION IF NXGEN=1, 
LOWER LIMIT OF UNIFORM DISTRIBUTION IF 
NXGEN=2 
XVAR -~ STANDARD DEVIATION OF NORMAL DISTRIBUTION 
IF NXGEN=1, UPPER LIMIT OF UNIFORM DISTRI- 
BUTION IF NXGEN=2 
NDIST -- ARRAY OF DIMENSION NPAR - RLOSS WHICH 
SPECIFIES THE STATISTICAL DISTRIBUTION 
FOR EACH COLUMN OF THE DESIGN MATRIX 
= @ IF NORMAL 
1 IF UNIFORM 
2 IF ZERO-ONE 
CLMEAN ~- ARRAY OF DIMENSION NPAR - RLOSS WHICH 
SPECIFIES FOR EACH COLUMN THE MEAN (IF 
NDIST=@), LOWER LIMIT (IF NDIST=1), OR 
PROPORTION P OF ZERO ENTRIES (IF NDIST=2) 
CLMVAR ~~ ARRAY OF DIMENSION NPAR - RLOSS WHICH 
SPECIFIES FOR EACH COLUMN THE STANDARD 
DEVIATION (IF NDIST=0), THE UPPER LIMIT 
(IF NDIST=1); NOT USED IF NDIST=2 


ft out 


** NOTE ** A CONSTANT COLUMN OF 1@S CAN BE GENERATED 


USING CLMEAN = CLMVAR = 1.@ AND NDIST = 1, 


FOR EXAMPLE. 


NREPS -- NUMBER OF TIMES EACH UNIQUE ROW IS TO 
APPEAR IN THE GENERATED DESIGN MATRIX 
NDEG -- NUMBER OF ZERO RESIDUALS OUTSIDE OF THE 
BASIS 
RLOSS -- NUMBER OF DEPENDENT COLUMNS ADDED 
NIND -- VALUE SUCH THAT THE DEPENDENT COLUMNS ARE 
GENERATED BY SUMMING NINI) SUCCESSIVE 
COLUMNS 
YDIST -- INTEGER WHICH SPECIFIES THE DISTRIBUTICN 
OF (NONZERO) RESIDUALS ASSOCIATED WITH 
THE NONACTIVE CONSTRAINTS 
= @ IF NORMAL 
= 1 IF UNIFORM 
YMEAN ~- MEAN OF RESIDUAL DISTRIBUTION (IF YDIST=@), 
OR LOWER LIMIT (IF YDIST=1) 
YVAR -- STANDARD DEVIATION OF RESIDUAL DISTRIBUTION 
(IF YDIST=%), OR UPPER LIMIT (IF YDIST=1) 
ISEED -- THE RANDOM NUMBER SEED USED TO 
INITIATE THE RANDOM NUMBER GENFRATOR 


** NOTE ** IF NXGEN, NDIST OR YDIST ARE OUTSIDE THE 
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INDICATED RANGES, THE REOUIRED DISTRIBUTION 
IS DEFAULTED TO THAT OF A NORMAL. 


OUTPUT ARGUMENTS: 


XOPT --— OPTIMAL SOLUTION VECTOR OF DIMENSION NPAR 
A -- GENERATED TRANSPOSE OF THE DESIGN MATRIX, WITH 
NPAR ROWS AND NOBS COLUMNS 
RHS -- RIGHT HAND SIDE (OR Y) VECTOR OF DIMENSION 
NOBS 
LACT -- VECTOR OF DIMENSION NPAR - RLOSS WHICH 
CONTAINS INDICES OF ACTIVE CONSTRAINT ROWS 
SUMRES -- OBJECTIVE FUNCTION VALUE, OR SUM OF 
ABSOLUTE VALUES OF RESIDUALS 
ISEED --- THE RANDOM NUMBER SEED AVAILABLE 
UPON TERMINATION OF GENERATION PROCESS 
IERR -- ERROR FLAG, UPON RETURN 
@ NORMAL EXECUTION 
1 FATAL ERROR 


Hou 


RESTRICTIONS: 


-LE. NOBS .LE. 4¢¢ 

.LE. NPAR .LE. 25 

.LE. NREPS .LE. NOBS 

.LE. NDEG .LE. NOBS-NPAR+RLOSS-2 
.LE. RLOSS .LE. NPAR-1 

.LE. NIND .LE. NPAR-RLOSS 
NOBS+RLOSS-NPAR-NDEG MUST BE EVEN 
NREPS MUST DIVIDE NOBS 


SSGHHEE 
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ALGORITHM 565 
PDETWO/PSETM/GEARB: Solution 

of Systems of Two-Dimensional 

Nonlinear Partial Differential Equations [D3] 


DAVID K. MELGAARD 

Kansas State University 

and 

RICHARD F. SINCOVEC 

Boeing Computer Services Company 


Key Words and Phrases: partial differential equations, method of lines, finite differences, ordinary 
differential equations 

CR Categories: 5.17 

Language: FORTRAN 


DESCRIPTION 


The algorithm presented here combines PDETWO, PSETM[1], and a modified 
version of GEARB[2] to form a complete partial differential equations package 
for systems of time-dependent nonlinear partial differential equations defined 
over a two-dimensional rectangular region. The descriptions of PDETWO and 
PSETM, test results, references, and the use of this algorithm are contained in 
the authors’ paper [2]. The ordinary differential equations package, GEARB, is 
described by Hindmarsh [1], so we only comment on those modifications that we 
made to GEARB for this algorithm. The principal modification is the addition of 
a new subroutine to set pointers for dynamic dimensioning of arrays and to check 
the validity of some of the user input parameters. The interpolation routine in 
GEARB was also modified so that it would return correctly interpolated solution 
values at the user-specified output time for time-dependent boundary conditions. 

Machine-readable documentation within the package serves as a complete 
user’s guide. The comments in subroutine PDETWO give the essential details on 
the use of this package, including descriptions of the user-required subroutines. 
Additional user information is contained in subroutine DRIVEP, the driver 
routine for the package. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service ]. 


SUBROUTINE PDETWO (NPDE,NX,NY,X,Y,T,U,DUDT,DVS,DVST, DV, DH, 
is AH, BH, CH, AV, BV, CV, UX, UY, DXI, DXIR, DXIC, 
* XAVG, UDVA, UDHR, UDVB, UDHL, UAVGH, UAVGV) 


RREEKKEREKREEERKKRKRERARKERKRARRRRERERKRAERRERKRARERRERERERERERERERERERERERR 


PDETWO IS AN INTERFACE DESIGNED TO SOLVE A SYSTEM OF SECOND 
ORDER TIME DEPENDENT PARTIAL DIFFERENTIAL EQUATIONS (PDE*S) 
DEFINED OVER A RECTANGLE IN CONJUNCTION WITH AN ORDINARY 
DIFFERENTIAL EQUATION (ODE) INTEGRATOR PACKAGE (PRIMARILY A MODI- 
FLIED VERSION OF GEARB(1)). IT IS AN EXTENSION OF PDEONE (2,3), AN 
INTERFACE DEVELOPED FOR THE SOLUTION OF ONE-DIMENSIONAL SYSTEMS OF 
PDE*S. THIS EXTENSION CONSISTS OF CHANGING FROM THREE POINT 
DIFFERENCING TO FIVE POINT DIFFERENCING IN ORDER TO APPROXIMATE 
THE SPATIAL DERIVATIVES IN THE TWO DIMENSIONAL PDE SYSTEM. TO 
SOLVE A PDE SYSTEM USING THIS SOFTWARE INTERFACE IN CONJUNCTION 
WITH AN ODE INTEGRATOR, THE USER IS REQUIRED ONLY TO PROVIDE 
THE SPATIAL MESH AND DEFINE THE PROBLEM’ TO BE EVALUATED. THE 
INTERFACE WILL THEN FORM AND EVALUATE A SEMIDISCRETE APPROXI- 
MATION OF THIS SYSTEM OF PDE*S AND THUS PERMIT ONE TO SOLVE 
THE ORIGINAL PDE SYSTEM AS A SYSTEM OF TIME DEPENDENT ODE*S 
USING AN ODE INTEGRATOR. 


TO CREATE A DOUBLE PRECISION VERSION OF PDETWO.. 
CHANGE THE REAL STATEMENT BELOW. 


ADANQDAAARAARAARANDAANAAAARANQNRAAAN 


CHRRKKKAKRKRAERKKEREKKEKKRRRERKKRRRKRRRRRRRERRRERERERERERREREKRERRRERERERKERREREREE 


C PROBLEM DEFINITION 
CRERKKKRRKARARKEREKEK RE RK EKER ERE REE R ERE RR ER RRR RRRERRERRRERERRERRERRREERERER 


PDETWO IS DESIGNED TO BE USED TO SOLVE A COUPLED SYSTEM OF 
NPDE PDE*S. THE L-TH PDE OF THIS SYSTEM IS OF THE FORM .. 


DUDT(L) = F (T, X, Y, U, UX, UY, DUXK, DUYY ) 
WHERE 


DUDT(L) REPRESENTS THE FIRST PARTIAL OF THE L-TH COMPONENT 
OF U WITH RESPECT TO T, 

T IS THE CURRENT TIME, 

X,Y DEFINE THE POSITION IN THE HORIZONTAL AND VERTICAL 
DIRECTIONS RESPECTIVELY, 


U a (UD). ace. wy UCNPDE): D5 
UX = ( UX(1), .-. , UX(NPDE) ), 
UY. = (€.UY@Q),. «s« . DYQNPDE) ), 


DUXX IS AN NPDE BY NPDE ARRAY SUCH THAT 
D 
DUXX(L, K) pater (DH(L,K) *UX(K)), 
DX 
THE L-TH ROW OF DUXX CORRESPONDS TO THE L-TH PDE, 


DUYY IS AN NPDE BY NPDE ARRAY SUCH THAT 
: D 
DUYY(L,K) = -- (DV(L,K)*UY(K)), 
DY 
THE L-TH ROW OF DUYY CORRESPONDS TO THE L-TH PDE, 


ANAAAAARAAAARAARARAAARAANRAAAANAAMAAANANAANAANAANAN 


Qe 
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> 
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U(K) IS THE VALUE OF THE SOLUTION FOR THE K-TH PDE AT 
(Ey Be 0s 

UX(K) IS THE FIRST PARTIAL DERIVATIVE OF U(K) WITH RESPECT 
TOK, 

UY(K) IS THE FIRST PARTIAL DERIVATIVE OF U(K) WITH RESPECT 
TO Y, 


DH(L,K) IS THE DIFFUSION COEFFICIENT IN THE HORIZONTAL 
DIRECTION FOR THE L-TH PDE ASSOCIATED WITH U(K), 

DV(L,K) IS THE DIFFUSION COEFFICIENT IN THE VERTICAL 
DIRECTION FOR THE L-TH PDE ASSOCIATED WITH U(K). 


DH(L,K) AND DV(L,K) MAY BE FUNCTIONS OF T, X, Y AND U. 


HORIZONTAL BOUNDARY CONDITIONS 


AH(L)*U(L) + BH(L)*UY(L) = CH(L) 


VERTICAL BOUNDARY CONDITIONS 


AV(L)*U(L) + BV(L)*UX(L) = CV(L) 


AH(L), BH(L) AND CH(L) (AV(L), BV(L) AND CV(L)) ARE AT LEAST 
PIECEWISE CONTINUOUS FUNCTIONS OF THEIR RESPECTIVE VARIABLES. 
IF BH(L) .NE. @ (BV(L) .NE. @) THEN AH(L), BH(L) AND CH(L) 
(AV(L), BV(L) AND CV(L)) MAY BE FUNCTIONS OF T, X, Y AND U 
BUT OTHERWISE THEY MAY ONLY BE FUNCTIONS OF T, X AND Y. NULL 
BOUNDARY CONDITIONS ARE NOT ALLOWED SINCE PDETWO WAS NOT 
DESIGNED TO SOLVE HYPERBOLIC PDE*S. A ZERO DIVIDE WILL OCCUR 
IF A NULL BOUNDARY CONDITION IS SPECIFIED. 


INITIAL CONDITIONS 


THE INITIAL SOLUTION IS DEFINED FOR EACH U(K) TO BE A 
KNOWN FUNCTION OF X AND Y FOR THE INITIAL TIME T = T@. 
THE INITIAL CONDITIONS NEED NOT BE CONSISTENT WITH THE 
BOUNDARY CONDITIONS AND MAY CONTAIN DISCONTINUITIES. 


CREKRARAARAKEARRARRARERE RARER RRERERRRRERRRRERRERERREREERRRRRERERRRRRRRRREERE 


C USER SUPPLIED ROUTINES 
CRRA AK AI AIK KARE RK AK KA KAR KK ER SRR RRR RRAR RRA RR ERE RRR RRR ERE RRR 


Ce a Se A > A aN She MD FE Se oS a ae he SD OR ae, Ms a SP ep Da ae ae Wi Yl > SD ea ee a 


THE USER MUST PROVIDE A MAIN PROGRAM AND FIVE SUBROUTINES 


BNDRYH, BNDRYY, DIFFV, DIFFH AND F. THESE ROUTINES ARE ALL THAT 
IS REQUIRED TO DEFINE COMPLETELY THE PROBLEM GIVEN ABOVE. 


1) 


THE MAIN PROGRAM DEFINES THE SPATIAL MESH, THE INITIAL 
CONDITIONS AND THE PARAMETERS FOR THE ODE INTEGRATOR, CALLS 
THE INTEGRATOR AND PRINTS OR PLOTS THE RESULTS. THE MAIN 
PROGRAM SHOULD BE CONSTRUCTED AS FOLLOWS 


DIMENSION U(***, *, **) ,X(*) ,Y(*4) 
DIMENSION WORK (*****) , LWORK (****) 


FOR THE DIMENSIONS ABOVE ENTER THE ACTUAL NUMERICAL 
VALUES FOR * = NX, ** = NY, *&* = NPDE , **** = NODE, AND 
RAKKK = NPDE * ( NPDE*(NX*2+3) + 13 + NX ) + NX*4 + 4*NODE 
+ LPW + LU 


WHERE 
NODE = NPDE*NX*NY 
LPW = 1 IF MITER = @ 
= (3*(NX+L)*NPDE-2)*NODE IF MITER = 1,2 
= NODE IF MITER = 3 
LU = NODE*(MORDER+1) 


SEE MF AND MORDER BELOW FOR THE DEFINITION OF MITER AND 
MORDER. 


DEFINE .. 


1) THE NUMBER OF MESH POINTS IN THE X (HORIZONTAL) DIRECTION, 
NX .GE. 3 AND THE NUMBER OF MESH POINTS IN THE Y (VERTICAL) 
DIRECTION, NY .GE. 3 ( TO CONSERVE STORAGE ORIENT THE 
PROBLEM SO THAT NX .LE. NY ), 

2) THE MESH POINTS (I.E. X(1) .LT. X(2) .LT. ... .LT. X(NX) 
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ANDY CL) GET. VOY) ALT axe. SLT. YAONY)), 

3) NPDE, THE NUMBER OF PARTIAL DIFFERENTIAL EQUATIONS, 

4) INITIAL VALUES FOR ALL OF U, 

5) MORDER, THE MAXIMUM ORDER OF THE METHOD USED IN THE 
MODIFIED GEARB. MORDER MUST BE LESS THAN OR EQUAL TO 12 
IF METH = 1 OR IF METH = 2, IT MUST BE LESS THAN OR EQUAL 
TO 5. SEE MF BELOW FOR THE DEFINITION OF METH. 

6) THE PARAMETERS FOR THE CALL TO THE INTEGRATOR, AND 

7) THE FIRST SIX LOCATIONS OF THE ARRAY IWORK AS FOLLOWS. 


IWORK(1) = NPDE 
IWORK(2) = NX 
IWORK(3) = NY 
IWORK(4) = MORDER 
IWORK(5) = NRWK 
IWORK(6) = NRIWK 


WHERE NRWK AND NRIWK ARE THE LENGTHS OF THE ARRAYS WORK 
AND IWORK RESPECTIVELY. THEY SHOULT BE AT LEAST EQUAL 
TO ***** AND **** AS DEFINED IN THE DESCRIPTION OF THE 
DIMENSIONS. 


IN DETERMINING THE MESH SPACING, THE USER SHOULD BE AWARE 
THAT THE DIFFERENCE APPROXIMATIONS AT THE INTERIOR POINTS 
ARE SECOND ORDER ONLY FOR UNIFORM MESHES. FOR NONUNIFORM 
MESHES, ONLY FIRST ORDER APPROXIMATIONS SHOULD BE EXPECTED, 
IN UNUSUAL SITUATIONS (SEE REMARK IN SECTION 3 OF THE 
ACCOMPANYING PAPER) INVOLVING COUPLED SYSTEMS OF EQUATIONS, 
CERTAIN APPROXIMATIONS AT THE BOUNDARY ARE ONLY FIRST ORDER. 
IN THESE UNUSUAL SITUATIONS THE ERROR CAN BE MINIMIZED BY 
CHOOSING SMALL MESH SPACINGS NEXT TO THE BOUNDARY. IN ANY 
CASE THE USER IS ADVISED TO CHOOSE A MESH WHICH IS LOCALLY 
NEARLY UNIFORM. 


FOR THE MODIFIED GEARB THE PARAMETERS INCLUDE THE DESIRED 
OUTPUT TIME (TOUT), THE DESIRED LOCAL ACCURACY (EPS), THE 
NUMBER OF ODE*S (NODE = NPDE*NX*NY), THE INITIAL TIME (TQ), 
THE INITIAL TIME STEP SIZE (H),THE TYPE OF CALL BEING MADE 
(INDEX) AND THE TYPE OF INTEGRATION METHOD DESIRED (MF). 

MF HAS TWO DECIMAL DIGITS, METH AND MITER (MF = 10*METH + 
MITER). METH IS THE BASIC METHOD INDICATOR... 
METH 1 MEANS THE ADAMS METHODS. 
METH 2 MEANS THE BACKWARD DIFFERENTIATION FORMULAS 
(BDF), OR STIFF METHODS OF GEAR. 
MITER IS THE ITERATION METHOD INDICATOR.. 
MITER = @ MEANS FUNCTIONAL ITERATION (NO PARTIAL 
DERIVATIVES NEEDED). 
MITER = 1 MEANS THE CHORD METHOD WITH AN ANALYTIC 
JACOBIAN SUPPLIED IN THE USER DEFINED 
ROUTINE PDB. THIS METHOD IS IN GEARB, 
LUT IT SHOULD BE AVOIDED. 
MITER = 2 MEANS THE CHORD METHOD WITH THE JACO- 
BIAN CALCULATED IN PSETM. THIS IS THE 
ONLY METHOD WHERE PSETM IS USEFUL. 
MEANS THE CHORD METHOD WITH THE JACO- 
BIAN REPLACED BY A DIAGONAL APPROXI- 
MATION BASED ON A DIRECTIONAL DERIV- 
ATIVE. THIS METHOD IS IN GEARB, BUT 
IS NOT GENERALLY USEFUL IN SOLVING PDE*S. 
SEE COMMENTS IN DRIVEP FOR ADDITIONAL INFORMATION ON THESE 
PARAMETERS. NATURALLY THESE PARAMETERS ARE DEPENDENT ON THE 
INTEGRATOR BEING USED. FINALLY THE USER SHOULD CALL THE 
INTEGRATOR. 


tl 
(es) 


MITER 


CALL DRIVEP (NODE,T@,H,U, TOUT, EPS,MF, INDEX, WORK, IWORK,X,Y) 


THE INTEGRATOR WILL RETURN THE SOLUTIONS (U) AT T = TOUT 

TO THE MAIN PROGRAM TO BE PRINTED OR PLOTTED. IF A CONTINUA- 
TION TO ANOTHER TOUT IS DESIRED, SIMPLY RESET TOUT AND CALL 
DRIVEP AGAIN. 


STOP 
END 
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2) 


to 
ww 


> 
ww 


THE BOUNDARY SUBROUTINES, BNDRYH AND BNDRYV PROVIDE 
PDETWO WITH THE COEFFICIENTS FOR THE HORIZONTAL AND 
VERTICAL BOUNDARY CONDITIONS RESPECTIVELY. THE CONSTRUCTION 
OF BNDRYV IS ANALOGOUS TO THE CONSTRUCTION OF BNDRYH. ‘THE 
USER SHOULD CONSTRUCT BNDRYH AS FOLLOWS .. 


SUBROUTINE BNDRYH (T,X,Y,U,AH, BH, CH, NPDE) 
DIMENSION U(NPDE), AH(NPDE), BH(NPDE), CH(NPDE) 


THE INCOMING PARAMETERS X AND Y REPRESENT ANY POINT 
OF X(J) (J = 1,2,...,NX) AND EITHER Y(1) OR Y(NY) RESPECTIVELY. 
DEFINE THE FUNCTIONS AH(K), BH(K) AND CH(K) (K = 1,2,...,NPDE) 
FOR THE LOWER (Y=¥(1)) AND UPPER (Y=Y(NY)) BOUNDARIES. NULL 
BOUNDARY CONDITIONS ARE NOT ALLOWED AND IF SPECIFIED WILL 
RESULT IN A ZERO DIVIDE. 


TO INSURE A COMPLETELY ACCURATE DEFINITION OF THE BOUNDARY 
CONDITIONS AT THE CORNER MESH POINTS, THE USER SHOULD 
CONSULT THE APPROPRIATE DIFFERENCE APPROXIMATIONS (SEE 
SECTION 3 OF THE ACCOMPANYING PAPER). 


RETURN 
END 


DIFFH AND DIFFV DEFINE FOR PDETWO THE HORIZONTAL AND VERTICAL 
DIFFUSION COEFFICIENTS RESPECTIVELY. THE CONSTRUCTION OF 
DIFFV IS ANALOGOUS TO THE CONSTRUCTION OF DIFFH. THE 
USER SHOULD CONSTRUCT DIFFH AS FOLLOWS .. 


SUBROUTINE DIFFH (T,X,Y,U,DH,NPDE) 
DIMENSION U(NPDE) , DH(NPDE, NPDE) 


IN THIS ROUTINE DEFINE THE DH(L,K) COEFFICIENTS (L,K = 
1,2,...,NPDE). THE INCOMING PARAMTERS X AND Y DENOTE EITHER 
A BOUNDARY POINT OR A MESH MIDPOINT. 


RETURN 
END 


THE RIGHT HAND SIDE OF THE PDE IS DEFINED FOR PDETWO IN 
THE SUBROUTINE F. THIS ROUTINE IS CONSTRUCTED AS FOLLOWS.. 


SUBROUTINE F (T,X,Y,U, UX, UY, DUXX, DUYY, DUDT, NPDE) 
DIMENSION U(NPDE), UX(NPDE), UY(NPDE), DUXX(NPDE,NPDE), 


* DUYY(NPDE,NPDE), DUDT(NPDE) 


IN THIS ROUTINE, THE INCOMING VALUES X AND Y REPRESENT 
THE MESH POINT BEING EVALUATED AND UX, UY, DUXX AND DUYY 
ARE THE VALUES DENOTED IN THE PROBLEM DEFINITION ABOVE. 
USING THESE VALUES, DEFINE IN DUDT(L) (L = 1,2,...,NPDE) 
THE RIGHT HAND SIDE OF THE PDE*S. 


RETURN 
END 


CREERKKARKEKEREREKERRERKERERRRRERERERRRRRERERRERERRRRKREERERERRERERERRRERERER 


C THE INPUT PARAMETERS 
CHRRAAK KER KEKE AKK REE K KERR ARR RRR ERE RARER REE ERA RERERERERRERRK 


AANMNANNANNRAAaAN 


NPDE IS THE NUMBER OF PARTIAL DIFFERENTIAL EQUATIONS. 


NX 


NY 


aH KM 


IS THE NUMBER OF MESH POINTS IN THE HORIZONTAL 
DIRECTION. 

IS THE NUMBER OF MESH POINTS IN THE VERTICAL 
DIRECTION. 

ARE THE MESH POINTS IN THE HORIZONTAL DIRECTION. 
ARE THE MESH POINTS IN THE VERTICAL DIRECTION. 
IS THE CURRENT TIME. 

CONTAINS THE CURRENT SOLUTION VALUES FOR ALL THE 
MESH POINTS. 
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DVS SAVES THE VERTICAL DIFFUSION CCEFFICIENTS FOR 
FUTURE EVALUATIONS. 

DVST SAVES THE VERTICAL DIFFUSION CCEFFICIENTS FOR THE 
FUTURE EVALUATIONS OF THE TOP ROW OF MESH POINTS. 

DH RETURNS FROM DIFFH THE HORIZONTAL DIFFUSION COEFFI- 


CIENTS AND CONTAINS DUXX, THE APPROXIMATIONS TO THE 
HORIZONTAL DIVERGENCE TERMS, ON CALLS TO F AND STORES 
THE PREVIOUS VALUE OF DUXX. 

DV RETURNS FROM DIFFV THE VERTICAL DIFFUSION COEFFI- 
CIENTS AND CONTAINS DUYY, THE APPROXIMATIONS TC THE 
VERTICAL DIVERGENCE TERMS, ON CALLS TO F. 

AH, BH, CH CONTAIN THE HORIZONTAL BOUNDARY COEFFICIENTS 
PASSED TO PDETWO FROM BNDRYH. 

AV, BV, CV CONTAIN THE VERTICAL BOUNDARY COEFFICIENTS 
PASSED TO PDETWO FROM BNDRYV. 

UX, UY STORE THE DIFFERENCE APPROXIMATIONS FOR THE FIRST 
PARTIAL OF U WITH RESPECT TO X AND Y RESPECTIVELY. 


DXI, DXIR, 
DXIC STORE INFORMATION ABOUT THE HORIZONTAL MESH SPACING. 
XAVG STORES INFORMATION ABOUT THE AVERAGE BETWEEN TWO MESH 
POINTS ON THE HORIZONTAL AXIS. 
UDVA, UDVB, 


UDHR,UDHL STORE INFORMATION FOR APPROXIMATING DUXX AND DUYY. 
UAVGH, UAVGV CONTAIN U AVERAGES FOR APPROXIMATING THE DIFFUSION 
COEFFICIENTS AT THE MESH MID-POINTS. 


QAADAAQANAAAAAAARAAIAAANANARAAARAD 


C 
CRHERRKKKRRKRAKREKRKKEKRERERERERRARERRRERRR RRR RR RRKREEERRERRERRKRRRERRERERRREK 


C THE OUTPUT PARAMETERS 
CRARKKKAKKEKK KKK EK ERKRE RRR ERE ERE RERRREER RRR ERE RRR KERR RRR REAR RERERR 


U CONTAINS SOLUTIONS UPDATED TO TIME T FOR THE 
BOUNDARY MESH POINTS DEFINED BY DIRICHLET BOUNDARY 
CONDITIONS. 

DUDT IS THE RIGHT HAND SIDE OF THE SYSTEM OF ODE*S PASSED 
TO THE INTEGRATOR. THESE VALUES ARE CALCULATED 
FROM THE CENTERED DIFFERENCE APPROXIMATIONS OF 
THE SPATIAL VARIABLES. 


AAADMANAANAN 


(o) 


CRERKKRRRKERRRRRERRRERRRRRRRERRKRRRERERRERRRRERRRERRRRRRRKRRERERRERERERERE 
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1. A. C. HINDMARSH, GEARB.. SOLUTION OF ORDINARY DIFFERENTIAL 
EQUATIONS HAVING BANDED JACOBIAN, UCID-30059 REV. 2, 
LAWRENCE LIVERMORE LABORATORY, P.0.BOX 868, LIVERMORE, 
CA 94556, JUNE 1977. 


C 
C 
C 
C 
C 
C 2. R.F. SINCOVEC AND N.K. MADSEN, SOFTWARE FOR NONLINEAR 
C PARTIAL DIFFERENTIAL EQUATIONS, ACM TRANSACTIONS ON 
C MATHEMATICAL SOFTWARE, SEPT. 1975, PP. 232-26@. 
C 
C 
C 
C 
C 
C 
C 


3. R.F. SINCOVEC AND N.K. MADSEN, ALGORITHM 494 PDEONE, 
SOLUTIONS OF SYSTEMS OF PARTIAL DIFFERENTIAL EQUATIONS, 
ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE, SEPT. 
1975, PP. 262-263. 
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SUBROUTINE PSETM (NPDE,NX,NY,X,Y,U, UMAX, USAVE, DUDTR, DUDT, PW, CON, 
7 MITER, IER, NEBAND, WORK, IWORK) 


EREKEKKERERKEREREKRKRRKEREEERERRERERERERERERERRERRERRERRERERREREREEEEERES 


PSETM IS INTENDED TO BE USED IN CONJUNCTION WITH THE 
INTERFACE PDETWO FOR THE SOLUTION OF SECOND CRDER TIME DEP- 
ENDENT PARTIAL DIFFERENTIAL EQUATIONS (PDE*S) DEFINED OVER A 
RECTANGULAR REGION. PSETM IS SPECIFICALLY DESIGNED TO REPLACE 
THE ROUTINE PSETB USED IN THE ORDINARY DIFFERENTIAL EQUATION 
INTEGRATOR GEARB (1) IN ORDER TO MINIMIZE THE COMPUTATIONS 
REQUIRED TO GENERATE THE JACOBIAN MATRIX. 


ANQANQAARAAANRAD 
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a 


PSETM IS CALLED BY STIFFP, A ROUTINE IN THE MODIFIED GEARB, 
WHEN THE INTEGRATION METHOD (MITER=1 OR 2) REQUIRES A JACOBIAN 
MATRIX. WHEN MITER=1, THE JACOBIAN IS DETERMINED BY A USER 
DEFINED ROUTINE, PDB. THIS METHOD SHOULD BE AVOIDED SINCE IT RE- 
QUIRES THE USER TO COMPLETELY UNDERSTAND PDETWO. IF THIS 
METHOD IS USED, PSETM OFFERS NO ADVANTAGE OVER PSETB. IF 
MITER=2, THE JACOBIAN IS APPROXIMATED BY FINITE DIFFERENCES, 
USING THE APPROXIMATION J = (DUDT(U+R) - DUDT(U)) / R, 
WHERE DUDT(U+R) AND DUDT(U) ARE THE VALUES OF THE RIGHT HAND 
SIDE OF THE PDE*S EVALUATED AT U+R AND U RESPECTIVELY, AND R 
IS SOME SMALL NUMBER. PSETM TAKES ADVANTAGE OF THE STRUCTURE 
OF THE JACOBIAN MATRIX REQUIRED BY PDETWO TO REDUCE THE COMPU- 
TATIONS NEEDED TO GENERATE THE MATRIX (REQUIRING ONLY 5 * NPDE 
CALLS TO PDETWO). WITH EACH CALL TO PDETWO, PSETM DETERMINES 


THE ENTRIES IN THE JACOBIAN FOR THE MESH POINTS IN THE FOLLOWING 
PATTERN .. 


x~ODOO 
oR eoRon--neome) 
OxOOOCO 
oOoO0C0cO KO 
oOnNMOC0O 
x~OO00 
oOOOxKM OO 
OoOxMOO0O 0 
OO0OORO 
OCOONMRCOO 


WHERE X REPRESENTS THE POINTS FOR WHICH THE JACOBIAN IS 
APPROXIMATED. MITER=2 IS THE RECOMMENDED METHOD. 


TO CREATE A DOUBLE PRECISION VERSION OF PSETM.. 
CHANGE THE REAL STATEMENT BELOW AND CHANGE THE SINGLE PRECISION 
FUNCTIONS ABS, SQRT, AND AMAX1. — 


CREKKAKKERKRKRERERKRERERERERRRRRRRERERRREKRRRRRRRERRRRERRRRRRRRRREREREREEREE 


C 


THE PARAMETERS 


CRERKRAKRERKKRAKERRRERRRRERRERERRRERRRRRERERRRERERRRRRERRRRRRERERERRRRRREKRER 


AANA AAAAAAARAANTAANAAARAARANDAAARAANRARAAANKRDCAANANDA 


NPDE IS THE NUMBER OF PARTIAL DIFFERENTIAL EQUATIONS. 

NX IS THE NUMBER OF MESH POINTS IN THE HORIZONTAL 
DIRECTION. 

NY IS THE NUMBER OF MESH POINTS IN THE VERTICAL 
DIRECTION. 

X ARE THE MESH POINTS IN THE HORIZONTAL DIRECTION. 

Y ARE THE MESH POINTS IN THE VERTICAL DIRECTION. 

U CONTAINS THE CURRENT SOLUTIONS OF THE PARTIAL 
DIFFERENTIAL EQUATIONS. 

UMAX IS THE MAXIMUM U VALUES, WHICH ARE USED TO SCALE 
THE VALUE IN R AND FOR ERROR CONTROL IN GEARB. 

USAVE IS A TEMPORY STORE FOR U VALUES. 

DUDTR IS THE VALUE OF DUDT(U+R) RETURNED FROM PDETWO. 

DUDT IS THE VALUE OF DUDT(U), WHICH IS PASSED TO PSETM 
FROM STIFFP. 

PW STORES THE APPROXIMATION FOR THE JACOBIAN. 

CON IS THE CONSTANT (-H*EL(1)). 

MITER INDICATES THE TYPE OF ITERATION METHOD BEING USED 


BY THE INTEGRATOR. 

MITER = @ MEANS FUNCTIONAL ITERATION. 

MITER = 1 MEANS THE CHORD METHOD WITH AN ANALYTIC 
JACOBIAN SUPPLIED IN THE USER DEFINED 
.ROUTINE PDB. THIS METHOD IS IN GEARB, 
BUT IT SHOULD BE AVOIDED. 

2 MEANS THE CHORD METHOD WITH THE JACO- 
BIAN CALCULATED IN PSETM. THIS IS THE 
ONLY METHOD WHERE PSETM IS USEFUL. 

3 MEANS THE CHORD METHOD WITH THE JACO- 
BIAN REPLACED BY A DIAGONAL APPROXI- 
MATION BASED ON A DIRECTIONAL DERIV- 
ATIVE. THIS METHOD IS IN GEARB, BUT 
IS NOT GENERALLY USEFUL IN SOLVING PDE*S. 

TER IS AN ERROR INDICATOR USED IN THE ROUTINE DECBR. 

NEBAND ae 9S ML ed 


MITER 


MITER 
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C 
C 
C 


a 


WORK 


IWORK 


PROVIDES WORKING STORAGE FOR DYNAMIC DIMENSIONING 
OF THE ARRAYS IN PDETWO AND THE MODIFIED GEARB. 
IS THE PIVOT VECTOR USED IN THE LU DECOMPOSITION. 


CERRKKEAKKEKKKRKRAREREKREERERERRERRRRERERRERERRERREERRRRRERRERRERERERRERER 


C THE VARIABLES 


CHRAKKAKEREERAKREKERREKRERERRRERERERRERRRRRRERERERERRERRRRRERERERERRKRERERE 


DQANMRAAAARANAANAANANANAANAANANAANA 


R 


UROUND 
EPSJ 
ML 


IW1l - IW27 


IS A SMALL INCREMENT USED IN EVALUATING THE 
FUNCTION NEAR THE CURRENT SOLUTION U ( I.E. 
DUDT (U+R)). 

IS A LOWER BOUND ON THE SIZE OF R. 

IS A SMALL NUMBER USED TO APPROXIMATE THE 
DERIVATIVE. 

= NX * NPDE 


IS THE TIME BEING USED FOR THE INTEGRATION. 

IS THE CURRENT TIME STEP SIZE BEING USED IN THE 
INTEGRATION. 

IS THE UNIT ROUNDOFF OF THE MACHINE. 

IS SQRT(UROUND). 

IS THE WIDTH OF THE LOWER (AND UPPER) HALF OF THE 
BAND OF THE JACOBIAN. ML = (NX +1) * NPDE - l. 
ARE THE SUBSCRIPT POINTERS USED TO INDICATE THE 
STORAGE LOCATIONS IN WORK OF ARRAYS IN PDETWO AND 
THE MODIFIED GEARB. 


CERRKRKRAERKREKRKREREREKRERRRRERRRERRRRRRRRERRERERERRRRERERRERRRRERREREREERERERKA 


C THE ROUTINES CALLED BY PSETM 
CHRKRRAKERARAKEKRRERERRRRERRRERRERERER ERR RE RE RRER ERE RE RERRERERRRERERERK 


-—D 


C 
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PDB(NODE,T,U,PW,NODE,ML,ML) IS A USER DEFINED ROUTINE WHICH DEFINES 


THE JACOBIAN IN PW IF MITER=1. SINCE THIS METHOD IS 
NOT RECOMMENDED, A DUMMY ROUTINE IS PROVIDED. 


DECBR(NEBAND, NODE,ML,ML, PW, IWORK,IER) COMPUTES THE LU DECOMPOSITION 


OF THE JACOBIAN FOR THE DIRECT SOLUTION OF THE 
JACOBIAN. 


PDETWO(NPDE,NX,NY,X,Y,T,U,...) IS THE INTERFACE WHICH DESCRETIZES 


THE SPATIAL VARIABLES OF THE TWO DIMENSIONAL SYSTEM OF 
PDE*S, THEREBY EVALUATING THE RIGHT HAND SIDE OF 
THE SYSTEM OF ODE*S. 


CREEKKAKRRKARKREKEKRRRKEKRERRRERRERERERRRERRERERERERRERERRRRRERERERERRRRRERERERE 
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REFERENCES 
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Cc 
Cc 
C 
C 
C 


l. A. C. HINDMARSH, GEARB.. SOLUTION OF ORDINARY DIFFERENTIAL 


EQUATIONS HAVING BANDED JACOBIAN, UCID-30059 REY. 2, 
LAWRENCE LIVERMORE LABORATORY, P.0.BOX 8@8, LIVERMORE, 
CA 94550, JUNE 1977. 
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ALGORITHM 566 

FORTRAN Subroutines for Testing 
Unconstrained Optimization Software [C5], 
[E4] 


JORGE J. MORE, BURTON S. GARBOW, and KENNETH E. HILLSTROM 
Argonne National Laboratory 


Key Words and Phrases: performance testing, systems of nonlinear equations, nonlinear least 
squares, unconstrained minimization, optimization software 

CR Categories: 4.6, 5.15, 5.41 

Language: FORTRAN 


DESCRIPTION 


This is the FORTRAN package of subroutines described in [1] for testing 
unconstrained optimization software. The following three problem areas are 
considered. 


(1) Zeros of systems of N nonlinear functions in N variables. 
(2) Least squares minimization of M nonlinear functions in N variables. 
(3) Unconstrained minimization of an objective function with N variables. 


The subroutines that define the test functions and starting points depend on 
the dimension parameters M and N and on the problem number NPROB. We 
first describe the subroutines for the test functions. 

For systems of nonlinear functions, 


VECFCN(N, X, FVEC, NPROB) 
returns the function values in the N-vector FVEC, and 
VECJAC(N, X, FJAC, LDFJAC, NPROB) 


returns the Jacobian matrix in the N by N array FJAC. (The parameter LDFJAC 
is the leading dimension of the array FJAC as defined in the main program.) In 
order to prevent gross inefficiencies with solvers that only require one function 
value at a time, 

COMFCN(N, K, X, FCNK, NPROB) 


returns the Kth function value in FCNK. 
For nonlinear least squares, 


SSQFCN(M, N, X, FVEC, NPROB) 
returns the function values in the M-vector FVEC, and 
SSQJAC(M, N, X, FJAC, LDFJAC, NPROB) 
returns the Jacobian matrix in the M by N array FJAC. 
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For unconstrained minimization, 
OBJFCN(N, X, F, NPROB) 
returns the objective function value in F, and 
GRDFCN(N, X, G, NPROB) 


returns the gradient components in the N-vector G. 
For each problem area, the starting points are generated by 


INITPT(N, X, NPROB, FACTOR) 


which returns in X the starting point corresponding to the parameters NPROB 
and FACTOR. If XS denotes the standard starting point, then X will contain 
FACTOR*XS, except that if XS is the zero vector and FACTOR is not unity, 
then all the components of X will be set to FACTOR. 

To test a code in any of the three problem areas, the user must provide a driver 
and interface routine. The driver reads in the data that define the dimensions, 
the problem number, and FACTOR, calls INITPT, and then calls the code of 
interest and prints out results. The interface routine provides a link between the 
code with its particular function routine calling sequences and the subroutines 
for the test functions. 

The package includes example drivers and interface routines for each of the 
problem areas. Sample data are also provided. 


REFERENCES 
1. Mork, J.J., GARBOW, B.S., AND HILLsTrom, K.E. Testing unconstrained optimization software. 
ACM Trans. Math. Soft. 7, 1 (March 1981), 17-41. 


ALGORITHM 


[Part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service ]. 


THIS PROGRAM TESTS CODES FOR THE UNCONSTRAINED OPTIMIZATION OF 
A NONLINEAR FUNCTION OF N VARIABLES. IT CONSISTS OF A DRIVER 
AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA, 
CALLS THE UNCONSTRAINED OPTIMIZER, AND FINALLY PRINTS OUT 
INFORMATION ON THE PERFORMANCE OF THE OPTIMIZER. THIS IS 

ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE 
INTERFACF SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE 
FORMS OF CALLING SEQUENCES USED BY THE FUNCTION SUBROUTINES 

IN THE VARIOUS UNCONSTRAINED OPTIMIZERS. 


SUBPROGRAMS CALLED 
USER-SUPPLIED ...... ENORM, FCN, SOLVER 
MINPACK-SUPPLIED ... GRDFCN, INITPT, OBJFCN 
FORTRAN-SUPPLIED ... DSQRT 


MINPACK. VERSION OF NOVEMBER 1978. 

BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE 
SUBROUTINE FCN(N,X, F,GVEC, IFLAG) 

INTEGER N,IFLAG 

DOUBLE PRECISION F 


DOUBLE PRECISION X(N) ,GVEC(N) 
KKKAKKKKKK 


AFAAAAAAANRQAARAAAARAAAAAAAN 


THE CALLING SEQUENCE OF FCN SHOULD BE IDENTICAL TO THE 
CALLING SEQUENCE OF THE FUNCTION SUBROUTINE IN THE 
UNCONSTRAINED OPTIMIZER. FCN SHOULD ONLY CALL THE TESTING 
FUNCTION AND GRADIENT SUBROUTINES OBJFCN AND GRDFCN WITH 
THE APPROPRIATE VALUE OF PROBLEM NUMBER (NPROB). 


DQAQAARAAN 
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ANQAANAAANANAANAAAANA 


SUBPROGRAMS CALLED 
MINPACK-SUPPLIED ... GRDFCN, OBJFCN 


MINPACK. VERSION OF JULY 1978. 
BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE 


RREEKREKREEE 


INTEGER NPROB, NFEV 
COMMON /REFNUM/ NPROB,NFEV 
CALL OBJFCN(N, X, F, NPROB) 
CALL GRDFCN(N, X,GVEC, NPROB) 
NFEV = NFEV + 1 

RETURN 


LAST CARD OF INTERFACE SUBROUTINE FCN. 


END 

SUBROUTINE INITPT(N,X,NPROB, FACTOR) 
INTEGER N,NPROB 

DOUBLE PRECISION FACTOR 


DOUBLE PRECISION X(N) 
RARKKKKKRE 


SUBROUTINE INITPT 


THIS SUBROUTINE SPECIFIES THE STANDARD STARTING POINTS FOR THE 
FUNCTIONS DEFINED BY SUBROUTINE OBJFCN. THE SUBROUTINE RETURNS 
IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING POINT. FOR 
THE SEVENTH FUNCTION THE STANDARD STARTING POINT IS ZERO, SO IN 
THIS CASE, IF FACTOR IS NOT UNITY, THEN THE SUBROUTINE RETURNS 
THE VECTOR X(J) = FACTOR, J=1,...,N. 


THE SUBROUTINE STATEMENT IS 

SUBROUTINE INITPT(N, X, NPROB, FACTOR) 
WHERE 

N IS A POSITIVE INTEGER INPUT VARIABLE. 


X IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE STANDARD 
STARTING POINT FOR PROBLEM NPRCB MULTIPLIED BY FACTOR. 


NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE 
NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18. 


FACTOR IS AN INPUT VARIABLE WHICH SPECIFIES THE MULTIPLE OF 
THE STANDARD STARTING POINT. IF FACTOR IS UNITY, NO 
MULTIPLICATION IS PERFORMED. 


MINPACK. VERSION OF JULY 1978. 

BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE 
SUBROUTINE OBJFCN(N, X, F,NPROB) 

INTEGER N,NPROB 

DOUBLE PRECISION F 


DOUBLE PRECISION X(N) 
KAKKKKKKER 


SUBROUTINE OBJFCN 


THIS SUBROUTINE DEFINES THE OBJECTIVE FUNCTIONS OF EIGHTEEN 
NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS. THE VALUES 

OF N FOR FUNCTIONS 1,2,3,4,5,10,11,12,16 AND 17 ARE 
3,6,3,2,3,2,4,3,2 AND 4, RESPECTIVELY. 

FOR FUNCTION 7, N MAY BE 2 OR GREATER BUT IS USUALLY 6 OR 9. 
FOR FUNCTIONS 6,8,9,13,14,15 AND 18 N MAY BE VARIABLE, 
HOWEVER IT MUST BE EVEN FOR FUNCTION 14, A MULTIPLE OF 4 FOR 
FUNCTION 15, AND NOT GREATER THAN 5@ FOR FUNCTION 18. 
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THE SUBROUTINE STATEMENT IS 
SUBROUTINE OBJFCN(N,X,F,NPROB) 

WHERE 
N IS A POSITIVE INTEGER INPUT VARIABLE. 
X IS AN INPUT ARRAY OF LENGTH N. 


F IS AN OUTPUT VARIABLE WHICH CONTAINS THE VALUE OF 
THE NPROB OBJECTIVE FUNCTION EVALUATED AT X. 


NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE 
NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18. 


SUBPROGRAMS CALLED 


FORTRAN-SUPPLIED ... DABS, DATAN, DCOS, DEXP, DLOG, DSIGN, DSIN, 
DSQRT 


MINPACK. VERSION OF JULY 1978. 
BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE 
SUBROUTINE GRDFCN(N,X,G,NPROB) 


INTEGER N,NPROB 


DOUBLE PRECISION X(N),G(N) 
HRERERAKKE 


SUBROUTINE GRDFCN 
THIS SUBROUTINE DEFINES THE GRADIENT VECTORS OF EIGHTEEN 
NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS. THE PROBLEM 
DIMENSIONS ARE AS DESCRIBED IN THE PROLOGUE COMMENTS OF OBJFCN. 
THE SUBROUTINE STATEMENT IS 
SUBROUTINE GRDFCN(N,X,G,NPROB) 
WHERE 
N IS A POSITIVE INTEGER INPUT VARIABLE. 
X IS AN INPUT ARRAY OF LENGTH N. 
G IS AN OUTPUT ARBAY OCF LENGTH N WHICH CONTAINS THE COMPONENTS 
OF THE GRADIENT VECTOR OF THE NPROB OBJECTIVE FUNCTION 
EVALUATED AT X. 


NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE 
NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18. 


SUBPROGRAMS CALLED 


FORTRAN-SUPPLIED ... DABS, DATAN, DCOS, DEXP, DLOG, DSIGN, DSIN, 
DSQRT 


MINPACK. VERSION OF JULY 1978. 
BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE 
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ALGORITHM 567 
Extended-Range Arithmetic and Normalized 
Legendre Polynomials [A1 ], [C1] 


D. W. LOZIER 

National Bureau of Standards 

and 

J. M. SMITH 

George Mason University and National Bureau of Standards 


Key Words and Phrases: angular momentum, extended-range arithmetic, Legendre polynomials, 
overflow, underflow 

CR Categories: 3.17, 4.9, 5.12 

Language: FORTRAN 


DESCRIPTION 


This algorithm consists of two logically distinct parts: (1) a package of six 
FORTRAN subroutines to facilitate the use of a special form of computer 
floating-point arithmetic that we call extended-range arithmetic; and (2) a FOR- 
TRAN subroutine that computes values of normalized Legendre polynomials 
according to an algorithm that generates (for some inputs) floating-point numbers 
that are outside the range of any computer. Our desire to produce a robust 
FORTRAN subroutine to compute these polynomials stimulated the develop- 
ment of the extended-range software package. This package may prove to be 
useful for many other computations. 
Normalized Legendre polynomials are defined by the formula 


Bechet qt GED heed” 

Pox) = {(> + 5) | (1 — x*) dx! P,(x), 
where p and pv are nonnegative integers, x is a real variable lying in the closed 
interval [—1, 1], and P,(x) is the ordinary Legendre polynomial. These functions 
satisfy a three-term recurrence relation in p that is useful in computing P4(x) for 
fixed vy and x, and sequences pu, fi + 1,..., U2 of values of yu. For stability reasons, 
the recurrence is applied in the backward direction, starting at » = v + 1 and 
u. = v and proceeding through v — 1, vy — 2,..., pi. The starting value of P?(x) is 
determined from a first-order recurrence relation, and P’?*'(x) = 0 for all », x. 
When x is close to +1 and pv is moderately large, this method fails because of 
underflow of early values in the recurrence sequence. Nevertheless, the method 
is attractive because of its inherent stability and simplicity. 

A simple extension of floating-point arithmetic, called extended-range arith- 
metic, overcomes this difficulty. A real number € is represented in three storage 
locations. Two of these hold a number x in ordinary double-precision form; the 
third holds a signed integer k. The value of € is given by 


Rk 
gé=xXr", 
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where r is the base (or radix) of double-precision numbers. In this (nonunique) 
representation «x is called the principal part and k is called the auxiliary index. 
Addition, subtraction, multiplication, and division of extended-range numbers 
are, of course, trivial to define. The main challenge was to design subroutines 
that are portable and, at the same time, as efficient as possible. Addition and 
conversion of extended-range numbers to a decimal form suitable for printing 
proved to be the most complicated. The subroutine for addition uses nine cases 
to preclude underflow and overflow of the principal part of the result. The 
algorithm used in conversion to decimal form requires triple-precision calculation 
to achieve double-precision accuracy in the converted value of r®, because of the 
possible large size of the auxiliary index k. 
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[Usage of the extended-range software is described in the comments in the 
initializing subroutine SETUP. These are reproduced below. Similarly, usage of 
NORMP (the subroutine for computing normalized Legendre polynomials) is 
described below. The complete listings are available from the ACM Algorithms 
Distribution Service ], 


C *** SUBROUTINE NORMP **%* 
SUBROUTINE NORMP(NU, MU1, MU2, ARG, MODE, PN, IFN, ISIG) 
INTEGER NU, MU1, MU2, MODE, IPN, ISIG 
DOUBLE PRECISION ARG, PN 


SUBROUTINE TO CALCULATE NORMALIZED LEGENDRE FOLYNOMIALS 

OF VARYING ORDER AND OF FIXED ARGUMENT AND DEGREE. 

THE ORDER MU AND DEGREE NU ARE NONNEGATIVE INTEGERS AND THE 
ARGUMENT IS REAL. THE ALGORITHM REQUIRES THE USE OF 

NUMBERS OUTSIDE THE NORMAL MACHINE RANGE. THEREFORE, 

THIS SUBROUTINE EMPLOYS A SPECIAL ARITHMETIC CALLED 
EXTENDED-RANGE ARITHMETIC. (SEE SMITH, J.M., OLVER, 
F.W.J., AND LOZIER, D.W., EXTENDED-RANGE ARITHMETIC 

AND NORMALIZED LEGENDRE POLYNOMIALS, ACM TRANSACTIONS 

ON MATHEMATICAL SOFTWARE, 1981). 


IN EXTENDED-RANGE ARITHMETIC EACH NUMBER IS REPRESENTED 

AS A PAIR (X,IX) WHICH HAS THE VALUE X*RADIX**IX, WHERE 
RADIX IS THE BASE IN WHICH CALCULATIONS ARE PERFORMED. FOR 
A FULL DESCRIPTION OF EXTENDED-RANGE ARITHMETIC, SEE THE 
COMMENTS AT THE BEGINNING OF SUBROUTINE SETUP. 


THE NORMALIZED LEGENDRE POLYNOMIAL IS A MULTIPLE OF THE 
ASSOCIATED LEGENDRE POLYNOMIAL OF THE FIRST KIND 

WHERE THE NORMALIZING COEFFICIENT IS CHOSEN SO THAT 

THE INTEGRAL OF THE SQUARE OF THE FUNCTION FROM -1 

TO +1 IS EQUAL TO 1 (SEE JAHNKE,E. EMDE,F. AND LOSCH,F., 
TABLES OF HIGHER FUNCTIONS, MCGRAW HILL, NEW YORK, 

196@, P. 121). 


THE INPUT VALUES TO NORMP ARE NU, MU1, MU2, ARG, AND MODE. 
THESE MUST SATISFY: 
1. NU IS A NON-NEGATIVE INTEGER SPECIFYING THE DEGREE. 
2. MUL AND MU2 ARE NON-NEGATIVE INTEGERS, WITH 
MU1.LE.MU2, SPECIFYING THE RANGE OF ORDERS. 
3. MODE IS AN INTEGER, RESTRICTED TO 1 OR 2, 
WHICH INDICATES WHICH OF TWO FORMS OF THE 


AAAAARAAAARAANDAAANRAARAANANRARAANKNANAAAAAN 
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DOUBLE-PRECISION VARIABLE ARG IS INTENDED: 

A. IF MODE=1 THEN NORMALIZED LEGENDRE(NU,MU,ARG) IS 
COMPUTED FOR ALL MU SUCH THAT MU1 .LE. MU .LE. MU2 . 
IN THIS CASE, -1 .LE. ARG .LE. 1 MUST BE SATISFIED. 

8B. IF MODE=2 THEN NORMALIZED LEGENDRE(NU,MU,COS ARG) IS 
COMPUTED FOR ALL MU SUCH THAT MU1 .LE. MU .LE. MU2 , 
IN THIS CASE, -PI .LT. ARG .LT. PI MUST BE SATISFIED. 


THE OUTPUT OF SUBROUTINE NORMP CONSISTS OF THE TWO 

ARRAYS PN AND IPN AND THE ERROR ESTIMATE ISIG. THE 

NORMALIZED LEGENDRE POLYNOMIALS ARE STORED AS EXTENDED- 

RANGE NUMBERS WITH DOUBLE-PRECISION PRINCIPAL PARTS 

IN ARRAY PN AND AUXILIARY INDICES IN ARRAY IPN. THUS 
(PN(1),IPN(1))=NORMALIZED LEGENDRE(NU,MU1, X) 
(PN(2),IPN(2) )=NORMALIZED LEGENDRE(NU,MU1+1, X) 


(PN(K), IPN(K) )=NORMALIZED LEGENDRE (NU, MU2,X) 

WHERE K=MU2-MU1+1 AND X=ARG IF MODE=1, OR X=COS ARG IF MODE=2. 
FINALLY, ISIG IS AN ESTIMATE OF THE NUMBER OF DECIMAL DIGITS 
LOST THROUGH ROUNDING ERRORS IN THE COMPUTATION. IF ARG IS 
ACCURATE TO N SIGNIFICANT DECIMALS, THEN THE COMPUTED FUNCTION 
VALUES ARE ACCCURATE TO N-ISIG SIGNIFICANT DECIMALS (EXCEPT IN 
NEIGHBORHOODS OF ZEROS OF THE FUNCTIONS). 

*k*k SUBROUTINE SETUP *** 

USAGE 

CALL SETUP (IRAD, NRADPL, DZERO, NBITS) 
DESCRIPTION 


SUBROUTINE SETUP MUST BE CALLED PRIOR TO CALLING ANY OTHER 
EXTENDED-RANGE SUBROUTINE. IT CALCULATES AND STORES SEVERAL 
MACHINE-DEPENDENT CONSTANTS IN COMMON BLOCKS. THE USER MUST 
SUPPLY FOUR CONSTANTS THAT PERTAIN TO HIS PARTICULAR COMPUTER. 
THE CONSTANTS ARE 


IRAD = THE INTERNAL BASE OF DOUBLE-PRECISION 

ARITHMETIC IN THE COMPUTER. 

NRADPL = THE NUMBER OF RADIX PLACES CARRIED IN 
THE DOUBLE-PRECISION REPRESENTATION. 

DZERO = THE SMALLEST OF 1/DMIN, DMAX, DMAXLN WHERE 
DMIN = THE SMALLEST POSITIVE DOUBLE-PRECISION 
NUMBER OR AN UPPER BOUND TO THIS NUMBER, 
DMAX = THE LARGEST DOUBLE-PRECISION NUMBER 
OR A LOWER BOUND TO THIS NUMBER, 
DMAXLN = THE LARGEST DOUBLE-PRECISION NUMBER 
SUCH THAT DLOG(DMAXLN) CAN BE COMPUTED BY THE 
FORTRAN SYSTEM (ON MOST SYSTEMS DMAXLN = DMAX). 

NBITS = THE NUMBER OF BITS (EXCLUSIVE OF SIGN) IN 
AN INTEGER WORD. 


SUBROUTINE SETUP(IRAD, NRADPL, DZERO, NBITS) 
INTEGER IRAD, NRADPL, NBITS 
DOUBLE PRECISION DZERO 


THIS IS THE SETTING-UP SUBROUTINE FOR A PACKAGE OF SUBROUTINES 
THAT FACILITATE THE USE OF EXTENDED-RANGE ARITHMETIC. EXTENDED-RANGE 
ARITHMETIC ON A PARTICULAR COMPUTER IS DEFINED ON THE SET OF NUMBERS 
OF THE FORM 


(X,IX) = X*RADIX**IX 


WHERE X IS A DOUBLE-PRECISION NUMBER CALLED THE PRINCIPAL PART, 

IX IS AN INTEGER CALLED THE AUXILIARY INDEX, AND RADIX IS THE 
INTERNAL BASE OF THE DOUBLE-PRECISION ARITHMETIC. OBVIOUSLY, 

EACH REAL NUMBER IS REPRESENTABLE WITHOUT ERROR BY MORE THAN ONE 
EXTENDED-RANGE FORM. CONVERSIONS BETWEEN DIFFERENT FORMS ARE 
ESSENTIAL IN CARRYING OUT ARITHMETIC OPERATIONS. WITH THE CHOICE 
OF RADIX WE HAVE MADE, AND THE SUBROUTINES WE HAVE WRITTEN, THESE 
CONVERSIONS ARE PERFORMED WITHOUT ERROR (AT LEAST ON MOST COMPUTERS) . 
(SEE SMITH, J.M., OLVER, F.W.J., AND LOZIER, D.W., EXTENDED-RANGE 
ARITHMETIC AND NORMALIZED LEGENDRE POLYNOMIALS, ACM TRANSACTIONS ON 
MATHEMATICAL SOFTWARE, 1981). 


AN EXTENDED-RANGE NUMBER (X,IX) IS SAID TO BE IN ADJUSTED FORM IF 
X AND IX ARE ZERO OR 


RADIX**(-L) .LE. DABS(X) .LT. RADIX**L 
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IS SATISFIED, WHERE L IS A COMPUTER-DEPENDENT INTEGER DEFINED IN THIS 
SUBROUTINE. TWO EXTENDED-RANGE NUMBERS IN ADJUSTED FORM CAN BE ADDED, 
SUBTRACTED, MULTIPLIED OR DIVIDED (IF THE DIVISOR IS NONZERO) WITHOUT 
CAUSING OVERFLOW OR UNDERFLOW IN THE PRINCIPAL PART OF THE RESULT. 
WITH PROPER USE OF THE EXTENDED-RANGE SUBROUTINES, THE ONLY OVERFLOW 
THAT CAN OCCUR IS INTEGER OVERFLOW IN THE AUXILIARY INDEX. IF THIS 

IS DETECTED, THE EXTENDED-RANGE SOFTWARE PRINTS A MESSAGE AND STOPS. 


MULTIPLICATION AND DIVISION IS PERFORMED BY SETTING 


(X, IX) *(Y,I¥) = (X*Y, LX+IY) 
OR 


PRE-ADJUSTMENT OF THE OPERANDS IS ESSENTIAL TO AVOID 
OVERFLOW OR UNDERFLOW OF THE PRINCIPAL PART. SUBROUTINE 
ADJUST (SEE BELOW) MAY BE CALLED TO TRANSFORM ANY EXTENDED- 
RANGE NUMBER INTO ADJUSTED FORM. 


ADDITION AND SUBTRACTION REQUIRE THE USE OF SUBROUTINE ADD 
(SEE BELOW). THE INPUT OPERANDS NEED NOT BE IN ADJUSTED FORM. 
HOWEVER, THE RESULT OF ADDITION OR SUBTRACTION IS RETURNED 
IN ADJUSTED FORM. THUS, FOR EXAMPLE, IF (X,IX),(Y,TY), 
(U,IU), AND (V,IV) ARE IN ADJUSTED FORM, THEN 


(X, IX) *(Y, EY) + (U,1U)*(V,1V) 


CAN BE COMPUTED AND STORED IN ADJUSTED FORM WITH NO EXPLICIT 
CALLS TO ADJUST. 


WHEN AN EXTENDED-RANGE NUMBER IS TO BE PRINTED, IT) MUST BE 
CONVERTED TO AN EXTENDED-RANGE FORM WITH DECIMAL RADIX. SUBROUTINE 
CONVRT IS PROVIDED FOR THIS PURPOSE. 


THE SUBROUTINES CONTAINED IN THIS PACKAGE ARE 


*k* SUBROUTINE ADD *** 

USAGE 
CALL ADD(X,1X,Y,1Y,Z,1Z) 

DESCRIPTION 
FORMS THE EXTENDED-RANGE SUM (Z,IZ) = 
(X.IX) + (¥,IY). (Z,1Z) IS ADJUSTED 
BEFORE RETURNING. THE INPUT OPERANDS 
NEED NOT BE IN ADJUSTED FORM, BUT THEIR 
PRINCIPAL PARTS MUST SATISFY 
RADIX**(-2L) . LE. DABS (X) . LE. RADIX**(2L) , 
RADIX**(-2L) . LE. DABS (Y) . LE. RADIX**(2L). 


**k* SUBROUTINE ADJUST *** 
USAGE 
CALL ADJUST (X, LX) 
DESCRIPTION 
TRANSFORMS (X,IX) SO THAT 
RADIX**(-L) .LE. DABS(X) «LT. RADIX**L. 
ON MOST COMP''TERS THIS TRANSFORMATION DOES 
NOT CHANCE THE MANTISSA OF X PROVIDED RADIX IS 
THE NUMBER BASE OF DOUBLE-PRECISION ARITHMETIC. 


**k* SUBROUTINE CNV21@ *** 
USAGE 

CALL CNV210(K,Z,J) 
DESCRIPTION 
GIVEN K THIS SUBROUTINE COMPUTES J AND Z 
SUCH THAT RADIX**K = Z*1@**J, WHERE Z IS IN 
THE RANGE 1/10 .LE. Z .LT. 1. 
THE VALUE OF Z WILL BE ACCURATE TO FULL 
DOUBLE. PRECISION PROVIDED THE NUMBER 
OF DECIMAL PLACES IN THE LARGEST 
INTEGER PLUS THE NUMBER OF DECIMAL 
PLACES CARRIED IN DOUBLE PRECISION DOES NOT 
EXCEED 6@. CNV21@ IS CALLED BY SUBROUTINE 
CONVRT WHEN NECESSARY. THE USER SHOULD 
NEVER NEED TO CALL CNV210@ DIRECTLY. 


*** SUBROUTINE CONVRT *** 
USAGE 
CALL CONVRT(X, IX) 
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Cc 
C 
Cc 
Cc 
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DESCRIPTION 


CONVERTS (X,IX) = X*RADIX**IX 

TO DECIMAL FORM IN PREPARATION FOR 
PRINTING, SO THAT (X,IX) = X*1O**IX 
WHERE 1/1@ .LE. DABS(X) .LT. 1 

IS RETURNED, EXCEPT THAT IF 

(DABS (X),1X) IS BETWEEN RADIX**(-2L) 
AND RADIX**(2L) THEN THE REDUCED 
FORM WITH IX = @ IS RETURNED. 


**k*k SUBROUTINE REDUCE *** 


USAGE 


DESCRIPTION 


CALL REDUCE(X, IX) 


IF 

RADIX**(-2L) “LE. (DABS(X),IX) .LE. RADIX**(2L) 
THEN REDUCE TRANSFORMS (X,IX) SO THAT IX=@. 

IF (X,IX) IS OUTSIDE THE ABOVE RANGE, 

THEN REDUCE TAKES NO ACTIOW. 

THIS SUBROUTINE IS USEFUL IF THE 

RESULTS OF EXTENDED-RANGE CALCULATIONS 

ARE TO BE USED IN SUBSEQUENT ORDINARY 
DOUBLE-PRECISION CALCULATIONS. 


LUERR IS THE OUTPUT UNIT NUMBER FOR ERROR MESSAGES, SET 
EQUAL TO 6 BELOW. SETUP DETERMINES THE OTHER COMMON VARIABLES 


FROM THE INPUT. 


COMMON /EXR1/ LUERR 

DOUBLE PRECISION RADIX, RADIXL, RAD2L, DLC1@R 

COMMON /EXR2/ RADIX, RADIXL, RAD2L, DLG1@R, L, L2, KMAX 
COMMON /EXR3/ NLG1@2, MLG102, LG102(21) 


567-P 5- 


0 


COLLECTED ALGORITHMS FROM ACM 


568-P 1- 0 


ALGORITHM 568 
PDS—A Portable Directory System 


DAVID R. HANSON 
The University of Arizona 


Key Words and Phrases: file system, UNIX, RATFOR 
CR Categories: 4.19, 4.33, 4.35, 4.41 
Language: RATFOR (FORTRAN) 


1. DESCRIPTION 


PDS is a set of procedures that provides a machine-independent method of file 
specification. PDS provides capabilities beyond those provided by many vendor- 
supplied systems. In addition; because PDS is portable, additional capabilities, 
such as protection schemes, file usage statistics, or some of the functions of a 
source code control system [5], can be added easily. 

The basic function of PDS is to maintain a useful directory structure and 
provide a set of primitives for manipulating that structure. The PDS directory 
structure is identical to the tree structure of the UNIX [4] file system, and many 
of the PDS primitives are identical to UNIX primitives. PDS is, in large part, a 
portable implementation of the UNIX directory system. Besides PDS’s machine- 
independence, the major differences are the extensibility of PDS and, as described 
in the next section, its i/o independence. 

In the simplest terms, PDS provides a directory structure and a mapping from 
machine-independent file names to machine-dependent names. It deals only with 
the information describing a file; it does not use or manipulate actual files in any 
way. The importance of this approach is that PDS is used to specify a file but 
does not participate in the actual i/o to that file. Consequently, there is no impact 
on i/o efficiency when PDS is used. 

PDS manipulates a rooted tree structure in which the leaves are files or 
directories and the nodes are directories. A directory is simply a list of files and 
directories. An example is shown in Figure 1, in which circles indicate directories 
and squares indicate files. The root of the tree is denoted by “/”, and files and 
directories are denoted by their “path,” which specifies their absolute position in 
the tree. A path is composed of the names of the nodes on the path from the root 
to the desired file or directory. The path components are separated by slashes; 
for example, the path for file “file2” in Figure 1 is “/m/n/file2.” The directory 
entries “.” and “..” refer, respectively, to the directory itself and to the immediate 
ancestor. These names may be used as path components, providing an explicit 
means of using the structural properties of the tree. If a path does not begin with 
“7”, it is taken to be rooted at the “current directory.” For example, with the 
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current 


a directory 


current directory at “n” in Figure 1, the path “file3” is equivalent to “/m/n/file3.” 

Files and directories are equivalent with the exception that directories are 
manipulated by PDS and files are not. Files simply “contain” the machine- 
dependent names of the actual files. These machine-dependent names are referred 
to as host names. The basic function of PDS is to map paths into host names. 

There are ten PDS primitives; they are summarized in Table I. Detailed 
descriptions of each primitive are given in [1] and in the machine-readable 
comments. The most important primitives are openf and creatf, which map a 
path to a host name and perform machine-dependent operations concerned with 
preparing files for i/o. The rest are concerned primarily with manipulating the 
directory structure. 

openf obtains the host name corresponding to path and calls a machine- 
dependent routine to actually open the file. mode indicates how the file is to be 
opened (e.g., “read’’, “write”, “append”, etc.). mode is not modified by openf, so 
it can be whatever is most appropriate on the host system. openf returns what 
the machine-dependent open routine returns, which is whatever is most useful as 
an argument in calling machine-dependent i/o routines that perform the actual 
i/o (e.g., read and write). Typically, a channel number or FORTRAN unit 
number is returned. 

creatf is similar to openf, except that path is created along with a host name 
and file. The generation of the host name is performed automatically. After the 
file is created, it is opened according to mode as if openf had been called. 

openf and creatf are insensitive to the values of mode. It is, however, useful to 
introduce standard values representing common file usage, such as reading and 
writing. This approach promotes machine-independence in programs that use 
PDS and is used, for example, with the programs described in [3]. Such mode 
values are scrutinized by the machine-dependent i/o interface routines, however, 
permitting PDS to be used in almost any environment—not just those in which 
i/o capabilities conform to preconceived notions of ‘‘common”’ file usage. 

PDS has no other i/o primitives; it is completely independent of the actual 
i/o. Thus, additional overhead is incurred in opening files, but none is incurred in 
accessing them. The effect of the additional overhead is minimal since the former 


Fig. 1. A directory system. 
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Table I. PDS Primitives 


chdir (path) change current directory to path 

chds (root, tlist) change to another directory system 
creatf (path, mode) create path and open it for i/o 

link (path1, path2) make a link to path1 named path2 
mkdir (path) make a directory named path 

mkds (root, tlist ) make a directory system 

mkfile (path, hname) make a file path with host name hname 
openf (path, mode) open path for i/o according to mode 
stat (path, array) return information about path 

unlink (path) unlink path 


is performed much less frequently than the latter. The contribution of PDS is a 
portable hierarchical directory system with absolutely no time impact on i/o 
efficiency. 


2. USAGE 


PDS is packaged as a set of RATFOR [2, 3] (and hence FORTRAN) functions 
and subroutines, which is loaded with the program or system that uses it. PDS is 
useful in programs or systems that use named files extensively, or where a 
machine-independent means of naming files and a flexible directory structure 
would enhance utility. Another use would be in a set of tools, such as those 
described in [3], implemented on computers with limited file systems. 

The following program, saveall, illustrates a typical use of PDS. It copies all 
of the files in the current directory to files of the same name in the directory 
“’/backup’”’. saveall is written in RATFOR in the style of [3]. 


# saveall - save all files in ../backup 
character dline(MAXLINE), bname(MAXLINE) 
integer /d, fdi, fdo 
integer openf, creatf, getlin 
string dot “.” 
string backup “../backup/” 
fd = openf (dot, READ) 
while (getlin(dline, fd) ~= EOF) { 

fdi = openf(dline(5), READ) 

call strcat (backup, dline(5), bname) 
[do = creatf(bname, WRITE ) 

call fcopy (fdi, fdo) 

call close (fdi) 

call close (fdo) 


ai close (fd) 

end Po 
Uppercase names denote defined constants; for example, a typical value for 
MAXLINE might be 80. The string statement declares a character array large 
enough to accommodate the indicated character string. The program begins by 
opening the current directory for reading using openf. The while loop reads the 
directory, line-by-line, until end-of-file, placing each line in the character array 
dline. As described in the next section, each line in a directory contains a file 
name beginning in column 5. Thus the body of the while loop opens each file for 
reading (openf), constructs the path name of the backup copy (strcat), creates 
the backup file and opens it for writing (creatf), copies the file (feopy), and 
finally closes the original and backup ‘files (close). 

This program makes use of the i/o routines described in [3] (getlin and close), 
but any other set of routines—including standard FORTRAN read and write 
statements—could be used. 

Another example of the use of PDS is as a simple command preprocessor that 
translates machine-independent system commands to the appropriate host com- 
mand sequence. In commands, files are referred to by their PDS names and are 
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mapped to the corresponding host names during the generation of host com- 
mands. For example, the command 


list files ... 


lists the named files on the line printer. The preprocessor translates the list into 
whatever is appropriate on the host system. For example, 


list ../backup/saveall.r saveall.r 
results in the DEC-10 command sequence 


r queue 
ilist.120, save.rat 


where “ilist.120” and “save.rat” are the host names for “../backup/saveall.r’” and 
“saveall.r’, respectively. 


3. IMPLEMENTATION 

PDS is designed to use only simple sequential i/o (i.e, FORTRAN i/o). It is 
implemented in RATFOR for portability reasons and because FORTRAN is the 
only widely available high-level language to which calls from other languages can 
be made. 

The implementation is similar to the implementation of the UNIX file system 
[7]. The basic technique is to separate the information about a file from the 
presence of that file in a directory. An i-node is associated with each file and 
directory, and it contains all of the information, including the host name, con- 
cerning the file. All of the i-nodes are stored in a single file in which i-node n is 
line n. This file, referred to as the 1-list, is stored in character format so that it 
can be read easily with FORTRAN 1/0 or its equivalent. 

The i-list maps i-node number, or i-number, to a host name. Directories provide 
a map of PDS name to i-number, thereby completing the mapping from PDS 
name to host name. A directory is a file of lines, each line containing an i-number 
and the corresponding PDS name. 

Further implementation details are given in [1]. 


4. INSTALLATION 


PDS consists of about 1000 lines of RATFOR including comments. Of this total, 
however, 300 lines are utility subroutines commonly available in a RATFOR 
environment. After preprocessing by RATFOR, the resulting FORTRAN code is 
about 1200 lines in length. The resulting FORTRAN conforms to the portable 
subset of ANSI standard FORTRAN as defined by PFORT [6]. 

On a DEC-10 (36-bit words, 512-word pages), the code area for the entire 
system occupies 6 pages and the data area occupies 17 pages. Small adjustments 
in the size of the data area can be made by changing various parameters, although 
the tendency seems to be to increase those parameters. 

As mentioned in the previous section, PDS operates using sequential i/o only. 
It is therefore possible to use FORTRAN i/o, although in practice modifications 
are necessary to avoid having to use FORTRAN unit numbers and to make use 
of named host files. PDS is written to use the i/o interface described in [3]; a 
FORTRAN version of these routines is provided along with suggested modifica- 
tions. 

Installation of the system using the FORTRAN version of the i/o interface can 
be accomplished in 1-2 man-days. The implementation of more sophisticated 
i/o systems requires substantial time investment, typically 3-6 man-months 
depending on the target system. This is unnecessary unless heavy use of the 
RATFOR i/o interface is anticipated. System-specific i/o systerns are supplied 
for the DEC-10 and Cyber 175. 

PDS can be modified to use standard FORTRAN 1/0 facilities directly (1.e., 
read and write statements). The modification requires replacing parts of the 
RATFOR i/o interface—the 300 lines of code mentioned above—with the appro- 
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priate standard FORTRAN i/o statements. While these modifications have not 
been made, similar experience suggests that 1-2 man-weeks is a conservative 
estimate of the effort required. 

PDS is distributed with the following components: 


PDS written in RATFOR 

PDS written in FORTRAN (RATFOR output) 

RATFOR and RATFOR i/o system written in RATFOR 
RATFOR and RATFOR i/o system written in FORTRAN 
DEC-10 i/o system 

Cyber 175 i/o system 
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Service ]. 
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ALGORITHM 569 
COLSYS: Collocation Software for 
Boundary-Value ODEs [D2] 


U. ASCHER 

University of British Columbia, Canada 

and 

J. CHRISTIANSEN and R. D. RUSSELL 
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Key Words and Phrases: ordinary differential equations, boundary-value problems, collocation, B- 
spline, mesh selection, error estimates, damped Newton's method, general-purpose code 

CR Categories: 5.17 

Language: FORTRAN 


DESCRIPTION 
This package is a complement to [1] where its usage is described and demon- 
strated. 

COLSYS uses the following non-American National Standard FORTRAN 
conventions: 


(1) No run-time subscript range checking. 

(2) Simple expressions used as subscripts. 

(3) Specifications of array values in DATA statements (used in subroutine 
CONSTS) by referring to the array name only. 


REFERENCES 
1. AscHER, U., CHRISTIANSEN, J., AND RUSSELL, R.D. Collocation software for boundary value 
ODEs. ACM Trans. Math. Softw. 7, 2 (June 1981), 209-222 


ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service .] 


SUBROUTINE COLSYS (NCOMP, M, ALEFT, ARIGHT, ZETA, IPAR, LTOL, 
1 TOL, FIXPNT, ISPACE, FSPACE, IFLAG, FSUB, 
4 DFSUB, GSUB, DESUB, SOLUTN) 

C 


C 
CHG EERE AEEEHEHRE EER HHRRREEHHER REE RHRRRR EERE RE 
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PURPOSE 


SUBROUTINE COLSYS SOLVES A MULTI-POINT BOUNDARY VALUE 
‘PROBLEM FOR A MIXED ORDER SYSTEM OF ODE-S GIVEN BY 


CMCT)) 
.¥ = F ¢ Xs ZOUCX)) 9) I= 1, » NCOMP 
I I 
ALEFYT .LT. X .LT. ARIGHT, 
G ¢ ZETACJ):) ZCUCZETACJ))) D= O Js is. ... .MSTAR 
J 
MSTAR=M(1)4M(2)+... +M(NCOMP), 
WHERE T 
UH (CU, UU, ... UU ) IS THE EXACT SOLUTION VECTOR 
1 2 NCOMP 
(MI) 
U TS THE MI=M(I) TH DERIVATIVE OF U 
I I 
(1) (M11) (MNCOMP--3) TT 
Z(UCX)) = CU (X),U (Xd,...0U (X),...0U (X)) 
1 1 1 NCOMP 


F (X,Z¢(U)) IS A (GENERALLY) NONLINEAR FUNCTION OF 
: Z{(UI=ZCUCX) D. 

G (ZETACJ)iZ(U)) IS A (GENERALLY) NONLINEAR BOUNDARY 
CONDITION. 


THE BOUNDARY -POINTS SATISFY 
ALEFT .LE. ZETAC1) .LE. .. .f£. ZETACMSTAR) . LE. ARIGHT 


THE ORDERS MI OF THE DIFFERENTIAL EQUATIONS. SATISFY 
Mi . LE. M2 .LE. ... .LE. MNCOMP .LE. 4. 
HEH EEE HE EE HEE ETE HEHE TE TE HEHEHE EEE EEE EEE EEE SE HE HEHEHE HEHE SE EE AEE ID SESE HE HE SEE EEE HE EE HE 
FEE SE HAE HE SEE Se HEHE HE INPUT TO COLSYS HEHEHE ESE HE HE EE 
VARTABLES 
NCOMP ~ NO. OF DIFFERENTIAL EQUATIONS (NCOMP .LE. 20) 


M(J) - ORDER OF THE J-TH DIFFERENTIAL EGUATION (¢ M(J). LE. M(U+1) 
AND MSTAR = M(1) +... + MCNCOMP) .LE. 40 ) 


ALEFT ~- LEFT END OF INTERVAL 
ARIGHT —- RIGHT END OF INTERVAL 


ZETA(J) -— J-TH SIDE CONDITION POINT (BOUNDARY POINT). MUST 
HAVE ZETA(J) .LE. ZETA(Jt1) 


IPAR ~- AN INTEGER ARRAY DIMENSIONED AT LEAST 11. 
A LIST OF THE PARAMETERS IN IPAR AND THEIR MEANING FOLLOWS. 
SOME PARAMETERS ARE RENAMED IN COLSYS, THESE NEW NAMES ARE 
GIVEN IN PARENTHESES. 


IPAR(1) ¢ = NONLIN ) 
O IF THE PROBLEM IS LINEAR 
1 IF THE PROBLEM IS NONLINEAR 


of 


IPAR (2) 


NO. OF COLLOCATION POINTS PER SUBINTERVAL = K ) 
WHERE MC(NCOMP) .LT. K .LE. 7 . IF IPAR(2)=0 THEN 
COLSYS SETS K = MAX ¢ M(NCOMP)4+1, S-M(NCOMP) ) 


AANAARANAANnNAANAAAANANAANAAAANAANNANANDG nnn nnnnnnnNAnHnaNnAAAAANNNAANAnAANANnNnANAnAANAHnAMoONANAAAnS 
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IPAR(3) 
IPAR (4) 


IPAR(S) 
TPAR (4) 


IPAR(7) 


IPAR(8) 


IPAR(9) 


IPAR(10) 


IPAR(11) 


LTOL - 


TOL = 


FIXPNT — 


ISPACE - 


NO. OF SUBINTERVALS IN THE INITIAL MESH (¢ = N ). 
IF IPAR(3) = 0 THEN COLSYS ARBITRARILY SETS N = 5 


NO. OF SOLUTION AND DERIVATIVE TOLERANCES. ( = NTOL ) 
WE REQUIRE O .LT. NTOL .LE. MSTAR. 


DIMENSION OF FSPACE. { NDIMF ) 


DIMENSION OF ISPACE. ( = NDIMI ) 


OUTPUT CONTROL. ¢ = IPRINT ) 

~1 FOR FULL DIAGNOSTIC PRINTOUT 
O FOR SELECTED PRINTOUT 

1 FOR NO PRINTOUT 


( = IREAD >) 
O CAUSES COLSYS TO GENERATE A UNIFORM INITIAL MESH. 
1 IF THE INITIAL MESH IS PROVIDED BY THE USER. IT 
IS DEFINED IN FSPACE AS FOLLOWS: THE MESH 


ALEFT=X(1).LT.X¢€2). LT. ©... . LT. XON). LT. XCN+1)=ARIGHT 
WILL OCCUPY FSPACE(1), ..., FSPACE(N+1). THE 

USER NEEDS TO SUPPLY ONLY THE INTERIOR MESH 

POINTS FSPACE(J) = X(J), Jz a... N 


2 IF THE INITIAL MESH IS SUPPLIED BY THE USER 
AS WITH IPAR(8)=1, AND IN ADDITION NO ADAPTIVE 
MESH SELECTION IS TO BE DONE. 


( = IGUESS > 

O IF NO INITIAL GUESS FOR THE SOLUTION IS 
PROVIDED: 

1 IF AN INITIAL GUESS IS PROVIDED BY THE USER 
IN SUBROUTINE SOLUTN. 

2 IF AN INITIAL MESH AND APPROXIMATE SOLUTION 
COEFFICIENTS ARE PROVIDED BY THE USER IN FSPACE. 
(THE FORMER AND NEW MESH ARE THE SAME). 

3 IF A FORMER MESH AND AN APPROXIMATE SOLUTION 
COEFFICIENTS ARE PROVIDED BY THE USER IN FSPACE, 
AND THE NEW MESH IS TO BE TAKEN TWICE AS COARSE. 

4 IF IN ADDITION TO A FORMER INITIAL MESH AND AN 
APPROXIMATE SOLUTION COEFFICIENTS, A NEW MESH 
IS PROVIDED IN FSPACE AS WELL. 

(SEE DESCRIPTION OF OUTPUT FOR FURTHER DETAILS 
ON IGUESS = 2, 3, AND 4. ) 


QO IF THE PROBLEM IS REGULAR 

1 IF THE FIRST RELAX FACTOR IS.=RSTART, AND THE 
NONLINEAR ITERATION DOES NOT RELY ON PAST COVERGENCE 
(USE FOR AN EXTRA SENSITIVE NONLINEAR PROBLEM GNLY). 

2 IF WE ARE TO RETURN IMMEDIATELY UPON (A) TWO 
SUCCESSIVE NONCONVERGENCES, OR (B) AFTER OBTAINING 
ERROR ESTIMATE FOR THE FIRST TIME. 


NO. OF FIXED POINTS IN THE MESH OTHER THAN 
ALEFT AND ARIGHT. ( = NFXPNT » THE DIMENSION OF FIXPNT) 


AN ARRAY OF DIMENSION IPAR(4). LTOL(J) = Lt SPECIFIES 
THAT THE J-TH TOLERANCE IN TOL CONTROLS THE ERROR 

IN THE L-TH COMPONENT OF Z(U). ALSO REQUIRE THAT 
1.LE.LTOL(1). LT. LTOL(2).LT. ... . LT. LTOL(NTOL). LE. MSTAR 


AN ARRAY OF DIMENSION IPAR(4). TOL(J) IS THE 

ERROR TOLERANCE ON THE LTOL(J) ~TH COMPONENT 

OF Z(U). THUS, THE CODE ATTEMPTS TO SATISFY 

FOR J=1,...,NTOL ON EACH SUBINTERVAL 

ABS(Z(V)-Z¢U) ) LE. TOL(J)#Z¢U) +TOL (JU) 
LTOL (J) LTOL (J) 

IF V(X) IS THE APPROXIMATE SOLUTION VECTOR. 


AN ARRAY OF DIMENSION IPAR(1i1). IT CONTAINS 
THE POINTS, OTHER: THAN ALEFT AND ARIGHT, WHICH 
ARE TO BE INCLUDED IN EVERY MESH. 


AN INTEGER WORK ARRAY OF DIMENSION IPAR(6). 
ITS SIZE PROVIDES. A CONSTRAINT ON NMAX, 

THE MAXIMUM NUMBER OF SUBINTERVALS. CHOOSE 
IPAR(6) ACCORDING TO THE FORMULA 
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IPAR(6) .GE. NMAX#NSIZEI 
WHERE 
NSIZEI = 3 + KDM — NREC 
WITH 
KDM = KAD + MSTAR ; KD = K * NCOMP ; 
NREC = NO. OF RIGHT END BOUNDARY CONDITIONS. 


FSPACE — A REAL WORK ARRAY OF DIMENSION IPAR(5). 
ITS SIZE PROVIDES A CONSTRAINT ON NMAX. 
CHOOSE IPAR(S5) ACCORDING TO THE FORMULA 
IPAR(S) .GE. NMAX#NSIZEF 
WHERE 
NSIZEF = 4+ K + 2 # KD + (4+2#K) # MSTAR + 
({KDM-NREC) * (KDM+1). 


IFLAG ~- THE MODE OF RETURN FROM COLSYS. 
= 1 FOR NORMAL RETURN 
= O IF THE COLLOCATION MATRIX IS SINGULAR. 
=-1 IF THE EXPECTED NO. OF SUBINTERVALS EXCEEDS STORAGE 
SPECIFICATIONS. 
=-2 IF THE NONLINEAR ITERATION HAS NOT CONVERGED. 
=-3 IF THERE IS AN INPUT DATA ERROR. 


HHHKHERAEHHRHRPKEHKAKERATHEKHHRHHREHERKEREKREHERHEHEHEHEHEHHEHHHRHHEHHEHHHERE RE 


HHEHHHHE EE USER SUPPLIED EXTERNAL SUBROUTINES HERE 


FSUB — NAME OF SUBROUTINE FOR EVALUATING F(X, Z(U(X))) = 
T 
(Fo... 0F ») AT A POINT X IN (ALEFT, ARIGHT). IT 
1 NCOMP 
SHOULD HAVE THE HEADING 


SUBROUTINE FSUB (X , Z; F) 


WHERE F IS THE VECTOR CONTAINING THE VALUE OF FI(X,Z(U)) 

IN THE I-TH COMPONENT AND T 
Z(UCX)9=0Z01)...., Z2°0NSTAR)) 

TS DEFINED AS ABOVE UNDER PURPOSE . 


DFSUB —. NAME OF SUBROUTINE FOR EVALUATING THE JACOBIAN OF 
FCX,Z(U)) AT A POINT X. IT SHOULD HAVE THE HEADING 
SUBROUTINE DFSUB (X , Z., DF) 
WHERE Z(U(X)) IS DEFINED AS FOR FSUB AND THE (NCOMP) BY 


{MSTAR) ARRAY DF SHOULD BE FILLED BY THE PARTIAL DERIV- 
ATIVES OF F, VIZ, FOR A PARTICULAR CALL ONE CALCULATES 


DFCI,J) = DFI / DZ I=i,...,NCOMP 
Jerd,...,MSTAR. 
GSUB —- NAME OF SUBROUTINE FOR EVALUATING THE I-TH COMPONENT OF 


GOX, ZCUCX))) = © CZETACTI), ZCUCZETACI)I))) AT A POINT X = 
I 
ZETACI) WHERE 1.LE.1.LE.MSTAR. IT SHOULD HAVE THE HEADING 


SUBROUTINE GSUB (I, Z, G) 
WHERE Z(U) IS AS FOR FSUB, AND I AND G=G ARE AS ABOVE. 
I 


NOTE THAT IN CONTRAST TO F IN FSUB . HERE 
ONLY ONE VALUE PER CALL IS RETURNED IN G. 


DGSUB — NAME OF SUBROUTINE FOR EVALUATING THE I-TH ROW OF 
THE JACOBIAN OF G(X, UCX)). IT SHOULD HAVE THE HEADING 
SUBROUTINE DGSUB (I. Z, DG) 


WHERE Z(U) IS AS FOR FSUB, I AS FOR GSUB AND THE MSTAR- 
VECTOR DG SHOULD BE FILLED WITH THE PARTIAL DERIVATIVES 


QANGAAAAGBNAAANAAAANNAAN nqgnnnnnAAnNAHnHAAnnnanANnAnnAANAAnN ANNAN AnAnAnaNnnaAnaannoonnAAAAANANAD 
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OF G, VIZ, FOR A PARTICULAR CALL ONE CALCULATES 
DG(I,J) = DGI / DZ . J=1,....,MSTAR. 


SOLUTN- NAME OF SUBROUTINE TO EVALUATE THE INITIAL 
APPROXIMATION FOR Z(UCX)) AND FOR DMVAL(UCX))= VECTOR 
OF THE MJ-TH DERIVATIVES OF U(X). IT SHOULD HAVE THE 
HEADING 


SUBROUTINE SOLUTN (X , Z. DMVAL) 


NOTE THAT THIS SUBROUTINE IS NEEDED ONLY IF USING 
IPAR(9) = 1. AND THEN ALL MSTAR COMPONENTS OF Z 

AND NCOMP COMPONENTS OF DMVAL SHOULD BE SPECIFIED 
FOR ANY X. ALEFT .LE. X .LE. ARIGHT . 


HEHEHE TE EE EEE EE EEE ETE HEE EE EEE EEE ME ACE EEE EE EE EEE aE HE EEE 


HEHHHHHRHEHHPHEHER OUTPUT. FROM cOLSYS HEHEHE EEE 


UPON RETURN FROM COLSYS , THE USER MAY PRODUCE THE 
SOLUTION VECTOR Z¢ U(X) >) AT A POINT X, ALEFT. LE. X. LE. ARIGHT 
BY CALLING : 


CALL APPSLN (X, Z, FSPACE, ISPACE) 


THIS SETS UP A STANDARD CALL TO APPROX . FOR A MORE 
EFFICIENT OR SOPHISTICATED RETRIEVAL OF THE SOLUTION 
VALUES, CALL APPROX DIRECTLY (SEE DOCUMENTATION IN 
APPROX - THE PARAMETERS NEEDED IN THE CALL TO APPROX 
BY THE USER ARE SAVED IN ISPACE AND FSPACE BEFORE 
COLSYS RETURNS). 


IN ORDER TO SAVE THE COEFFICIENTS OF THE SOLUTION FOR LATER 

REFERENCE, ISPACE(1). ..., ISPACE(7+MSTAR) AND 
FSPACE(1), .... FSPACECISPACE(7)) SHOULD BE 

SAVED, SINCE THESE ARE USED IN THE CALL TO APPSLN (APPROX). 


ONE CAN ALSO USE THE FORMERLY OBTAINED APPROXIMATE 

SOLUTION AS A FIRST APPROXIMATION FOR THE NONLINEAR ITERATION 
ON A NEW PROBLEM (E.G. FOR CONTINUATION PURPOSES). THIS 
INVOLVES USING IGUESS = 2, 3, OR 4. AS FOLLOWS: 


FOR IGUESS= 2 OR 3, THE USER SHOULD PUT THE ABOVE SAVED 

VALUES BACK INTO FSPACE(1)....,FSPACECISPACE(4)). 

THE SIZE OF THE FORMER MESH. NOLD., IS PROVIDED IN IPAR(3). IF 
IGUESS=2 THEN THE SIZE OF THE NEW MESH, N, IS TAKEN TO BE =NQLD. 
IF IGUESS=3 THEN N := NOLD/2 AND THE NEW MESH IS TO BE TWICE AS 
COARSE. 

FOR IGUESS=4, PUT N IN IPAR(3) AND NOLD IN ISPACE(1). THE 
VALUES OF THE FORMER SOLUTION, SAVED AS DESCRIBED ABOVE, 

SHOULD BE PUT INTO FSPACE(N+2),...,FSPACECISPACE(6)4+N+1),. AND 
A NEW MESH UNRELATED TO THE FORMER ONE IS PRESCRIBED IN 
FSPACE(1),....FSPACE(N+1). 


HHRMA KHHHHEHEHEHHRKEEHHHKRHHHHHHHRRHRHHEHHRRER HE 


SRSA EEE aE aE eR HE PACKAGE SUBROUTINES HHH HHH EE 


THE FOLLOWING DESCRIPTION GIVES A BRIEF OVERVIEW OF HOW THE 
PROCEDURE [5 BROKEN DOWN INTO THE SUBROUTINES WHICH MAKE UP 
THE PACKAGE CALLED COLSYS . FOR FURTHER DETAILS THE 

USER SHOULD REFER TO DOCUMENTATION IN THE VARIOUS SUBROUTINES 
AND TO THE REFERENCES CITED ABOVE. 


THE SUBROUTINES FALL INTO FOUR GROUPS: 


PART 1 —- THE MAIN STORAGE ALLOCATION AND PROGRAM CONTROL SUBROUTINES. 


COLSYS - TESTS INPUT VALUES, DOES INITIALIZATION AND BREAKS UP 
THE WORK AREAS, FSPACE AND ISPACE, INTO THE ARRAYS 
USED BY THE PROGRAM. 
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CONTRL - IS THE ACTUAL. DRIVER OF THE PACKAGE. THIS ROUTINE 


CONTAINS THE STRATEGY FOR NONLINEAR PROBLEMS. 


PART 2 - MESH SELECTION AND ERROR ESTIMATION SUBROUTINES 


CONSTS - IS CALLED ONCE BY COLSYS TO INITIALIZE CONSTANTS 


WHICH ARE USED FOR ERROR ESTIMATION AND MESH SELECTION. 


NEWMSH - GENERATES MESHES. IT CONTAINS THE TEST TO DECIDE 


WHETHER OR NOT TO REDISTRIBUTE A MESH. 


ERRCHK - PRODUCES ERROR ESTIMATES AND CHECKS AGAINST THE 


TOLERANCES AT EACH SUBINTERVAL 


PART 3 - COLLOCATION SYSTEM SET-UP SUBROUTINES 


LSYSLVY =~ CONTROLS THE SET-UP AND SOLUTION OF THE LINEAR 


ALGEBRAIC SYSTEMS OF COLLOCATION EQUATIONS WHICH 
ARISE AT EACH NEWTON ITERATION. 


BLDBLK - IS USED BY LSYSLYV TO SET UP THE EQUATION(S) ASSOCIATED 


WITH A SIDE CONDITION POINT OR A COLLOCATION POINT. 


PART 4 — B-SPLINE SUBROUTINES 


APPSLN 
APPROX 


BSPFIX 


BSPVAR 


BSPDER 


APPDIF 


HORDER 


SETS UP A STANDARD CALL TO APPROX 
EVALUATES A PIECEWISE POLYNOMIAL SOLUTION. 


EVALUATES THE MESH INDEPENDENT B-SPLINES 
(I.E. THE FIXED B-SPLINES) 


EVALUATES THE MESH DEPENDENT B-SPLINES (I.E. The 
VARYING B-SPLINES) 


GENERATES VALUES FOR THE DERIVATIVES NEEDED TO SET 
UP THE COLLOCATION EQUATIONS. 


GENERATES A DIVIDED DIFFERENCE TABLE FROM THE B-SPLINE 
COEFFICIENTS FOR A COLLOCATION SOLUTION. THE TABLE 
IS USED IN APPROX 


EVALUATES THE HIGHEST ORDER DERIVATIVES OF THE 
CURRENT COLLOCATION SOLUTION USED FOR MESH REFINEMENT. 


TO SOLVE THE LINEAR SYSTEMS OF COLLOCATION EQUATIONS 
CONSTRUCTED IN PART 3. COLSYS USES THE PACKAGE 
SOLVEBLOK OF DE BOOR ~- WEISS (TO APPEAR IN TOMS). 
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ALGORITHM 570 
LOPSI: A Simultaneous Iteration Algorithm 
for Real Matrices [F2] 


WILLIAM J. STEWART 

North Carolina State University 

and 

ALAN JENNINGS 

Queen’s University, Belfast, Northern Ireland 


Key Words and Phrases: eigenvalues, eigenvectors, simultaneous iteration, real unsymmetric 
matrices, large sparse matrices 

CR Categories: 5.14 

Language: FORTRAN 


DESCRIPTION 
The algorithm given here is a complement to [1] where the description, test 


results, and references are given. 


REFERENCES 


1. Stewart, W.J., AND JENNINGS, A. A simultaneous iteration algorithm for real matrices. ACM 
Trans. Math. Softw. 7,2 (June 1981), 184-198. 


-ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service .] 


SUBROUTINE LOPSI(N, A, IA, TROW, ICOL, LCR, IR. M, IS, TOL, ITMAX, LMAX, U. TU, 
1 V,W.G,H,B,P, IG, INT, X.Y, ERR, ITTOT. INACT, IFAIL) 


*# COPSI IS A SIMULTANEOUS ITERATION ALGORITHM WHICH 
DETERMINES APPROXIMATIONS TO RIGHT OR LEFT EIGEN- 
VECTORS CORRESPONDING TO THE DOMINANT SET CF 
EIGENVALUES OF A REAL UNSYMMETRIC MATRIX A. +e 


BY WILLIAM J. STEWART AND ALAN JENNINGS. 


FORMAL PARAMETER LIST. 
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He HE He He HE He He HE HE EE EE EH 


INPUT PARAMETERS (MUST BE SET BEFORE ENTRY AND ARE UNALTERED 
eH Me EE HE HE HE aE ea Ete aE Ht BY THE EXECUTION OF THE ALGORITHM) 


N AN INTEGER QUANTITY, THE ORDER OF THE MATRIX A FOR WHICH 
THE PARTIAL EIGENSOLUTION IS TO BE OBTAINED. 


A A ONE-DIMENSIONAL REAL ARRAY OF LENGTH AT LEAST EQUAL 
TO IA. IT CONTAINS IN ARBITRARY GRDER THE NON-ZERO 
ELEMENTS OF THE MATRIX A. 


IA AN INTEGER QUANTITY, THE NUMBER OF NON-ZERO ELEMENTS IN 
THE MATRIX A. 


IROW A ONE-DIMENSIONAL INTEGER ARRAY OF LENGTH AT LEAST EQUAL TO 
IA. THE I-TH COMPONENT DENOTES THE ROW POSITION OF THE 
NON-ZERO ELEMENT STORED IN POSITION I OF ARRAY A. 


ICOL A ONE-DIMENSIONAL INTEGER ARRAY OF LENGTH AT LEAST EQUAL TO 
IA. THE I-TH COMPONENT DENOTES THE COLUMN POSITION OF THE 
NON-ZERO ELEMENT STORED IN POSITION I OF ARRAY A. 


LR AN INTEGER QUANTITY. IF LR=1 ON ENTRY, THEN THE RIGHT EIGEN- 
VECTORS CORRESPONDING TO THE DOMINANT EIGENVALUES WILL BE 
OBTAINED. OTHERWISE THE LEFT SET WILL BE OBTAINED. 


IR AN INTEGER QUANTITY, THE NO. OF VECTORS REQUIRED ACCURATELY 


M AN INTEGER QUANTITY, THE NO. OF TRIAL VECTORS EMPLOYED. 
M SHOULD NORMALLY BE CHOSEN SO THAT M >= IR+2 — 


1s AN INTEGER QUANTITY, THE NUMBER OF TRIAL VECTORS FOR WHICH 
INITIAL APPROXIMATIONS ARE SUPPLIED BY THE USER. 


TOL A REAL QUANTITY, THE TOLERANCE DEMANDED OF THE EIGENVECTORS 
CORRESPONDING TO THE IR DOMINANT EIGENVALUES. 
THE EIGENVALUES ARE NORMALIZED TO HAVE LARGEST COMPONENT 
UNITY AND "LOPSI" AIMS FOR EACH COMPONENT TO BE IN ERROR 
BY LESS THAN TOL. IN GENERAL IT CAN BE EXPECTED THAT 
THE CORRESPONDING EIGENVALUES HAVE A RELATIVE ERROR 
LESS THAN TOL. 


ITMAX AN INTEGER QUANTITY, AN UPPER BOUND ON THE NUMBER OF MATRIX 
BY VECTOR MULTIPLICATIONS TO BE PERFORMED 


LMAX AN INTEGER QUANTITY, THE MAXIMUM NUMBER OF PREMULTIPLIC-- 
ATIONS PERMITTED BETWEEN TWO REORIENTATIONS 
THE VALUE LMAX = 10 SHOULD BE ADEGUATE FOR MOST PROBLEMS 
HOWEVER SET LMAX = 1 WHEN EXPECTING FAST CONVERGENCE 
FOR FURTHER INFORMATION SEE SECTION 3 OF THE PAPER 

Iv AN INTEGER QUANTITY. THE DECLARED FIRST DIMENSION OF 
ARRAYS VU, V AND W. 


IG AN INTEGER QUANTITY, THE DECLARED FIRST DIMENSION 
OF WORK ARRAYS G. H, B, P. 


INPUT AND OUTPUT PARAMETER 
FEMME AE TE He SE A TE TE AE HE SE I He EE a HE HEE 


U A TWO-DIMENSIONAL REAL ARRAY OF AT LEAST (N, M) ELEMENTS. ON 
ENTRY IT CONTAINS USER SUPPLIED APPROXIMATIONS TO THE EIGEN- 
VECTORS CORRESPONDING TO THE IS DOMINANT EIGENVALUES. 

ON EXIT IT CONTAINS THE FINAL ESTIMATES TO THE EIGENVECTORS 
CORRESPONDING TO THE M DOMINANT EIGENVALUES. 


OUTPUT PARAMETERS 
HE HEHE HEE HE 
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X, Y ONE-DIMENSIONAL REAL ARRAYS OF LENGTH AT LEAST EQUAL TO M. 
QN EXIT THE REAL AND IMAGINARY PARTS OF THE J-TH EIGENVALUE 
PREDICTION ARE STORED IN X(J) AND Y(JU) RESPECTIVELY 


ERR A ONE-DIMENSIONAL REAL ARRAY OF AT LEAST M ELEMENTS. ON EXIT 
ERR(J) DENOTES THE ESTIMATED ACCURACY OF THE J-TH VECTOR. 
ERROR ESTIMATES, AS MEASURED BY THE MAXIMUM OF THE ABSOLUTE 
DIFFERENCES IN THE COMPONENTS OF SUCCESSIVE APPROXIMATIONS, 
ARE GIVEN FOR ALL M VECTORS INCLUDING THOSE THAT HAVE NOT 
SATISFIED THE CONVERGENCE CRITERIA SPECIFIED UNDER TOL. 


ITTOT AN INTEGER QUANTITY WHICH ON EXIT DENOTES THE 
NUMBER OF PREMULTIPLICATIONS PERFORMED. 


INACT AN INTEGER QUANTITY WHICH ON EXIT DENOTES THE 
NUMBER OF INTERACTION ANALYSES PERFORMED. 


IFAIL AN INTEGER QUANTITY. ON EXIT IFAIL=0 IF FIRST IR VECTORS 
HAVE SATISFIED THE CONVERGENCE CRITERIA, OTHERWISE IFAIL=1. 


WORK ARRAYS 
HAE HE HEE He EE HE at at 


ViW TWO-DIMENSIONAL REAL WORK ARRAYS OF AT LEAST (N. M) ELEMENTS 


G.H, FOUR TWO-DIMENSIONAL REAL WORK ARRAYS 
B,P OF AT LEAST (M, M) ELEMENTS EACH. 


INT A ONE-DIMENSIONAL INTEGER WORK ARRAY OF AT LEAST M ELEMENTS. 


DOUBLE PRECISION A.B, DIFF1, DIFF2, DLAM, DLAMM, DLAMR, DLAM1, EMAX 
DOUBLE PRECISION ERR, FMAX, G,H, P. SIGMA, SUM, TOIT, TOL, TOT. TOT, TOT2 
DOUBLE PRECISION U,V. W, X, Y., EPMACH, EPS 

DIMENSION ACTA), IROW(IA), ICOL( IA), UCIU.M), VCIULM),WCIU, M) 
DIMENSION @(IG,M),H(IG,M), BCIG,M),P(IG, M) 

DIMENSION XK(M), Y(M), INTCM), ERR(M) 
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ALGORITHM 571 

Statistics for von Mises’ and Fisher’s 
Distributions of Directions: 

1,(x)/1(Xx), 1, (X)/loX), 


and Their Inverses [S14] 


GEOFFREY W. HILL 
CSIRO, Australia 


Key Words and Phrases: direction statistics, von Mises distribution, Fisher distribution, modified 
Bessel function ratio, continued fraction, function inversion, Newton—Raphson 

CR Categories: 5.5, 5.12 

Language: FORTRAN 


DESCRIPTION 


Two pairs of FORTRAN functions provide for-evaluation of the ratio of modified 
Bessel functions of the first kind, A (xk) = [i(k)/Zo(«) or B(k) = Ths(k)/los(«) = coth 
« — 1/« or their inverses, A~'(R), B™'(R). A (k) is the expected value of the mean 
modulus R of random unit vectors ih two dimensions, distributed with concentra- 
tion parameter « in von Mises’ [5] distribution of directions on a circle, whereas 
B(x) = E(R) for Fisher’s [1] distribution of three-dimensional directions on a 
sphere. The inverse functions, A7’(R) and B™'(R) are corresponding maximum 
likelihood estimators of « for observed R. 

Other versions of each function are fairly readily achieved, which provide some 
choice of precision level in the real valued result, summarized in Table I. 

The function BESRAT is illustrated as a 9.3. version, which selects between 
continued fractions detailed in [3] for backward recursive evaluation from a depth 
determined by parameter values C1 and C2, assigned with CX to DATA constants 
as indicated in comment cards. Within the tested range of precision the values 
specified for these parameters prevent occurrence of zero divisors in evaluation 
of the continued fractions. A version with S decimal digit precision assignable-at- 
call (up to limitations imposed by processor precision) can be obtained by 
changing the first card to rad FUNCTION BESRAT(V, S), by deleting C from 
column 1 of cards defining C1, C2, and CX, and by suppressing the DATA card. 

The function VKAPPA achieves 8S results by means of different initial 
approximations and up to two Newton-Raphson improvements adapted for 
several subintervals of the range of valid arguments. The Newton-Raphson steps 
call on BESRAT in a 9.3S version to compensate for some loss of precision for R 
near 1, such as occurs in Algorithm AS81 [6]. None of the five expressions 
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Table I 
FORTRAN Function Argument* Result Precision” 
BESRAT(V) O0<=« =|V| A(k) in (0, 1) 9.3 (5-14) 
VKAPPA(R) O<R<1 A '(R)=0 8 (5) 
SPHERR(CAPPA) 0< « =|CAPPA| B(k) in (0, 1) 13 (5-20) 
CAPPA3(R) O=R<1 B-M\R)=0 16 (8, 25) 


* Definition of « as the modulus of the actual parameter value avoids an error condition, 
whereas for invalid argument R < 0 or R = 1 the value — 1.0 is returned as an error 
signal result. 

» Precision is quoted as the least number of correct significant decimal digits in test 
results on a CDC 7600 of the FORTRAN version illustrated (range of precision tested 
is noted in parentheses). It is assumed that argument values are represented exactly and 
that the result precision is not appreciably limited by that of the processor. 


occurring as divisors in the code can become zero for arguments within the 
relevant subintervals, so that processor arithmetic overflow cannot occur. 

For analysis of observational data, less precise versions may be adequate [2], 
such as a fast 5S version of VKAPPA, obtained by assigning the value 0.74 to V1 
and 0.89 to V2 in the DATA statement and by replacing the two conditional 
statements before label 30 by columns 29 to 72 of either to leave one unconditional 
Newton-Raphson call of a 6S version of BESRAT. In any case, the backward 
recursive evaluation of the continued fractions reduces accumulation of roundoff 
error and enables a substantially faster and more compact code than previously 
published procedures [2, 6], which involve some ten or more evaluations of 
numerator and denominator of the Bessel function ratio. 

The function SPHERR determines B(x) either by backward recursive evalua- 
tion of the continued fraction form of coth k — 1/k or, if « > 1, by means of the 
exponential form of coth, as outlined in [3]. Unnecessary evaluation of the 
exponential function and possible overflow for large argument is avoided by 
evaluating B(x) as 1 — 1/« for large values of « > BIGX = 1.1513 * S + 0.4, which 
ensures S decimal digit precision in the result. The depth of recursion is also 
simply determined as a function of desired precision S, as indicated in comment 
cards defining DATA constants. A version with precision assignable-at-call may 
be obtained by including S as a formal parameter and replacing the DATA 
statement by the assignments SON4 = S/4 and BIGX = 1.1513 x S + 0.4. 

The function CAPPA3 achieves 8S precision in the result B-'(R) by means of 
inverses of the continued fraction and exponential forms of coth x — I/k, 
empirically extended over different subintervals of the argument [3]. Unnecessary 
evaluation of the exponential function and possible overflow for argument R near 
1.0 are avoided by accepting 1/(1 — R) as the result, if that value exceeds. BIGX 
= 1.1513 xk S + 0.4. Of course, the effective precision of the argument and 
therefore that of the result are limited by that of the difference, 1 -- R. 

Precision of the initial approximation may be extended by Newton-Raphson 
inversion of B(x), using SPHERR(—) to provide the Bessel function ratio to a 
precision of S + 1 decimals to allow for loss of up to one decimal cligit precision 
in the improvement. A version with precision up to 8S is obtained by deleting 
statements between label 20 and 30 of the version below, which caters for 
precision up to 16S. Precision could be extended to 25S by repeating the statement 
preceding label 30 or 32S by repeating the three statements preceding label 30, 
changing the DATA constants W1, W2 from 10.0, 0.01 to 20.0 and 0.001, respec- 
tively, and adjusting the precision of the auxiliary procedure SPHERR(-—) ac- 
cordingly. 

Test programs on a CDC 7600 checked precision claims using single-precision 
(48B) versions of BESRAT and VKAPPA and double-precision (96B) versions 
of SPHERR and CAPPAS3. Tabulated values checked against tables to 5D [5] 
identified some errors in published tables [4], but otherwise confirmed the validity 
of the functions BESRAT, VKAPPA, SPHERR, and CAPPAS. 
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ALGORITHM 


{The complete listing is printed here and is available from the ACM Algorithms 
Distribution Service .] 
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FUNCTION BESRAT(V) 


RETURNS BESRAT = ACK) FOR K = ABS(V), WHERE ACK) IS THE EXPECTED 
MODULUS OF THE MEAN VECTOR SUM OF UNIT VECTORS SAMPLED FROM THE 
VON MISES DISTRIBUTION OF DIRECTIONS IN 2D WITH PARAMETER = K. 
ACV) = THE RATIO OF MODIFIED BESSEL FUNCTIONS OF THE FIRST KIND 
OF ORDERS 1 AND O, I.E... ACV) = T1CVI/STOCV). 
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ADJUST TO S DECIMAL DIGIT PRECISION BY SETTING DATA CONSTANTS — 


Ci = (S+9, 0-8. 0/S) #0. 0351 
C2 = ((S-5. 0)##3/180. 0+9-5. 0)/10. 0 
CX = §#0.5 + 11.0 
FOR S IN RANGE (5,14). THUS FOR § = 9.3 
DATA C1/0. 613/, C2/0. 475/, CX/15. 65/ 
Y= 0.0 
X = ABS(V) 
IF (X.GT. CX) GO TO 20 


FOR SMALL X, RATIO = X/(CO4+X#X/(4+X#X/(G+XHX/ (B+ 22. Dd) 


N = INT((X+16. 0-16. O/ (X#C140. 75) #C1) 
X = X#0.5 
XX = X#X 
DO 10 J = 1. N 
10 Y = XX/(FLOAT(N-JU+2)+Y) 
BESRAT = X/(1.0+Y) 
RETURN 


FOR LARGE X, RATIO = 1-2/¢4X-1-1/¢(4X/3-2-1/¢04X/5-2- ... 97) 
20 N = INT((68. O/X+1.0)#C2) + 1 

= X#4.0 

X = FLOAT(Nt2+1) 

030 J= 1. N 

XX/€ 0-2. O--V) #XX+4X) 

XX - 2.0 


30 : 
1.0-2. O/ (X—-1. O-Y) 


FUNCTION VKAPPAC(R) 
RETURNS VKAPPA = THE MAXIMUM LIKELIHOOD ESTIMATE OF ’KAPPA’, THE 
CONCENTRATION PARAMETER OF VON MISES’ DISTRIBUTION OF DIRECTIONS 
IN 2 DIMENSIONS, CORRESPONDING TO A SAMPLE MEAN VECTOR MODULUS R. 
VKAPPA = K(A), THE INVERSE FUNCTION GF A(K) = RATIO OF MODIFIED 
BESSEL FUNCTIONS OF THE FIRST KIND, VIZ., ACK) = IT1L(KI/IOCK). 
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FOR 8S (SIGNIFICANT DECIMAL DIGITS) PRECISION AUXILIARY ROUTINE 
FUNCTION BESRAT(V) MUST BE SET TO AT LEAST 9. 3S 


DATA V1/0. 6427, V2/0. 95/ 
A=R 
S = -1.0 
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ERROR SIGNAL: VALUE -1.0 RETURNED IF ARGUMENT -VE OR 1.0 OR MORE. 


IF (A.LT.0.0 .OR. A. GE. 1.0) GO TO 30 
Y = 2.0/(1.0-A) 
IF (A. GT. 0.85) GO TO 10 


FOR R BELOW 0.85 USE ADJUSTED INVERSE TAYLOR SERIES. 


X = AXA 

S = (((A-5. 6076) #At+5. 0797) #A-4. 6494) #Y#X -— 1.0 

S = (0¢(S#X+15. 0) #X+60. 0) #X/360. OF1. O) #X-2. O) HAS (X—-1. 0) 
IF (V1-A) 20, 20, 30 


FOR R ABOVE 0.85 USE CONTINUED FRACTION APPROXIMATION. 
10 IF (A. GE.0.95) X = 32. 0/(120. O#A-131. 5+Y) 
IF (A.LT.0.95) X = (-23926. O#A+4317. 5526) #4-2001. 035224 
S = (¥+1,. 0+3. 0/7 (Y-5. 0-12. O/ (Y-10. O-X)) ) #0. 25 
IF (A. GE. V2) GO TO 30 


FOR R IN (0. 642,0.95) APPLY NEWTON-RAPHSON, TWICE IF R IN 
(0. 75,.0.875), FOR 8S PRECISION, USING APPROXIMATE DERIVATIVE — 
20 Y = ((0. OOO48#Y-0. 1589) #Y+0. 744)#Y - 4.2932 
IF (A. LE.0.875) S (BESRAT(S)—-A)#Y + S 
IF (A. GE.0.75) S (BESRAT(S)-A)#Y + S 
30 VKAPPA = S 
RETURN 
END 


wou 


FUNCTION SPHERR(CAPPA) 
RETURNS SPHERR = B(K) FOR K = ABS(CAPPA). B(K) IS THE EXPECTED 
MODULUS OF THE MEAN VECTOR SUM OF UNIT VECTORS SAMPLED FROM THE 
FISHER DISTRIBUTION OF DIRECTIONS IN 3D WITH PARAMETER = CAPPA. 
B(K) = THE RATIO OF MODIFIED BESSEL FUNCTIONS OF THE FIRST KIND 
OF ORDERS 372 AND 1/72, EQUIVALENT TO COTH(K) — L/K. 


FOR S DECIMAL DIGIT PRECISION AND TO AVOID EXPONENTIAL OVERFLOW 
SET SON4 = S/4 AND BIGX = 1.1513#5+0.4, £.G., FOR 48B = 14.455; 
DATA SON4/3. 61/7, BIGX/17. O/ 


T 0.0 
X ABS(CAPPA) 
IF (X. GT. 1.0) GO TO 20 


FOR SMALL X EVALUATE GAUSS CONTINUED FRACTION X/(3+X#X/(5+...)) 
UP FROM J-TH LEVEL, WHERE N=2#J+1 YIELDS S DECIMALS PRECISION. 
N = INT((X+0. 88) #S0N4)#2 + 5 
XX = X+#X 
10 T XX/(CFLOAT(N) +T) 
N N- 2 
IF (N.GT.3) GO TO 10 
SPHERR = X/(T+3. 0) 
RETURN 


ft ot 


FOR LARGE X USE EXPONENTIAL FORM OF COTH(X) - 1/X 
20 IF (X.LT. BIGX) T = 2. O/(EXP(2. O#X)-1. 0) 
SPHERR = T + 1.0 - 1.0/% 
RETURN 
END 


FUNCTION CAPPA3(R) 


RETURNS CAPPAS3 = THE MAXIMUM LIKELIHOOD ESTIMATE OF ‘KAPPA’, THE 
CONCENTRATION PARAMETER OF THE FISHER DISTRIBUTION OF DIRECTIONS 
IN 3 DIMENSIONS, CORRESPONDING TO A SAMPLE MEAN VECTOR MODULUS R. 
CAPPAS = K(B). THE INVERSE FUNCTION OF B(K) = RATIO OF MODIFIED 
BESSEL FUNCTIONS OF THE FIRST KIND OF ORDERS 3/72 AND 1/72. 


FOR PRECISION UP TO 8S (SIGNIFICANT DECIMAL DIGITS) OMIT THREE 
LINES FOLLOWING STATEMENT LABELED 20. FOR GREATER PRECISION UP 
TO 16S THE AUXILIARY SUBPROGRAM, FUNCTION SPHERR(X), IS NEEDED 
WITH PRECISION ONE DECIMAL DIGIT GREATER THAN FOR CAPPAS(R). 
TO AVOID EXPONENTIAL OVERFLOW SET BIGX = 1.15139#S5 + 0.4; FOR 488 
DATA BIGX /17.0/7, W1/10.0/, W2/0. O1/ 
Y=R 
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ERROR SIGNAL: VALUE -1.0 RETURNED IF ARGUMENT -VE OR 1.0 OR MORE 
IF (Y.LT.0.0 .GR. Y.GE.1.0) GO TO 30 
IF ¢Y.LT.0.5) GO TO 10 


FOR LARGE R APPROX. INVERSE OF R = COTH(K) - 1/K. (YIELDS 8. 1S) 


X¥ = 1.0/¢1.0-Y) 
IF (X.GT. BIGX) GO TO 30 
= 2. OFX 
= EXP(S) - S¥S - 1.0 
F CY.LT. 0.8) T = (€((0. 00254#S-0. 071042) #5+0. 6943388) #5 
-2. 3816184)#5 + 0.1508478 - 0. 14789#Y + T 


S 
T 
I 


X = T#X/(T+S) 
IF (X-W1) 20, 20,30 


FOR SMALL R USE INVERSE GAUSS CONTINUED FRACTION. (YIELDS 8. 4S) 


10 


ONE 
20 


30 


x 
S 
T 


= 3. OKY 
= X#X 
= 12.375 


IF (X.GT.0.7) T = (€¢€5. O#X-14. 74) #X+16. 5198) #X+6. 2762 


x 


X/(1. O-S/¢15. 0-4. O#S/(7. O-S/ (5. O-S/T)))) 


STAGE NEWTON-RAPHSON INVERSION DOUBLES PRECISION. 
IF (X.LT.W2) GO TO 30 


S 
i) 
x 


EXP (X) 
S#2. O/ (S#*S-1. 0) 
X + (Y-SPHERR(X))/¢1. O/ CX#X)-S#S) 


| 


CAPPAS = X 
RETURN 
END 
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ALGORITHM 572 

Solution of the Helmholtz Equation for the 
Dirichlet Problem on General Bounded 
Three-Dimensional Regions [D3] 


DIANNE P. O’LEARY 
University of Maryland 
and | 
OLOF WIDLUND 

New York University 


Key Words and Phrases: Helmholtz equation, capperance: matrix, fast Polsson solvers, conjugate 
gradients © s 

CR Categories: 5.17 

Language: FORTRAN 


DESCRIPTION 
This ee provides an penis solution to the Hereholtz Eien 


| —Au + cu = g in Q 
with a Dirichlet boundary condition 
| u=f  onT, the boundary of &. 


Here Q, a three-dimensional bounded region, c, an arbitrary real constant (posi- 
tive, negative, or zero), and the functions f and g are specified by the user. The 
Laplace operator A is in Cartesian coordinates. | 

A second-order accurate finite- difference method is used to discretize the 
Helmholtz equation. The resulting linear system of equations is reduced to a 
capacitance matrix equation that is solved approximately by a conjugate gradient 
method. We sketch the basic ideas ‘below, but a detailed discussion of this and 
similar methods can be found in [1]. 

To perform the discretization, the region Q is embedded in a cube and a 
uniform rectangular finite- -difference grid is imposed. A simple seven-point differ- 
ence approximation is used for all mesh points except those that are in Q and are 
near the boundary I’. For these boundary neighbors, second-order accurate 
equations incorporating the boundary data are used. The resulting difference 
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scheme is known as the Shortley-Weller method. Thus the discrete system of 
equations has a matrix that differs from that for a Helmholtz problem on the 
cube only in those rows that correspond to points near I. We take advantage of 
this by reformulating the problem as one of dimension equal to the number of 
boundary neighbors rather than the number of mesh points in the region. The 
resulting linear system is the capacitance matrix equation. In our implementation 
this reduced equation is then solved using an iterative algorithm, the conjugate 
gradient method. A special scaling method, based on so-called discrete dipoles, is 
used to enhance the convergence. A fast Poisson solver on the cube is one of the 
components necessary to evaluate the product of the capacitance matrix with a 
given vector. 

Let NX, NY, and NZ be the numbers of mesh points in the cube along the 
three coordinate axes, where NX and NY are powers of 2. We denote the number 
of mesh points in Q with at least one of their six nearest neighbors on or outside 
the boundary I’ by IPP1 + IPP2, where IPP2 points have two such neighbors 
along at least one coordinate mesh line. The program requires as input certain 
scalar parameters, the coordinates of each of the IPP1 + IPP2 points and their 
distances to the boundary along mesh lines, the values of the Dirichlet data f at 
points of intersection of mesh lines and the boundary I’, and the value of the 
function g at mesh points in 2. The user communicates with the package through 
the subroutine HELM3D. A complete description of the input parameters is 
given in the comments at the beginning of this subroutine. 

HELMSD controls the conjugate gradient iteration and calls upon a fast solver 
(CUBE) and subroutines UTAMLT, UTATRN, BNDRY, VMULT, and 
VTRANS to perform the necessary matrix-vector products. CUBE solves the 
Helmholtz equation on a cube using fast discrete Fourier transform routines 
RFORT and FORT to reduce the systems to tridiagonal form. The resulting 
linear systems are solved by a Toeplitz method, and then an inverse Fourier 
transform is performed. RFORT and FORT were provided by Dr. W. Prosku- 
rowski, who has modified a code written by Dr. J. Cooley. HELM3D also employs 
an error-checking module HELMCK to check the input data. It diagnoses errors 
in the integer parameters, missing boundary points, and inconsistencies in the 
given boundary data. 

The program requires two arrays of dimension NX x NY x NZ (one if g = 0), 
four integer and six real arrays of dimension IPP1 + 2 * IPP2, and one real array 
of dimension max(IPP1 + 2 « IPP2, NX « NZ, NY * NZ). Each conjugate gradient 
iteration requires time proportional to NX * NY * NZ *« LOG (NX * NY), and 
the number of iterations will usually be small unless a value of c is used that 
makes the discrete Helmholtz operator almost singular. Double precision is 
required on machines with a short word length. 

Data on timing for many sample problems are given in [1]. As an example, a 
discrete Laplace problem on a cube with a sphere cut out of it having 10464 mesh 
points and embedded in a cube of dimension 32 x 32 « 24 required 84K words of 
storage and 171 seconds on a CDC 6600 (FTN compiler, OPT = 2) to find a 
solution of the linear system with a maximum error equal to 0.55 x 107° of the 
maximum value of the solution. 

A sample driver is included with the algorithm. Possible enhancements to the 
algorithm are discussed in [1]. 


REFERENCES 
1, O'LEARY, D. P., AND WIDLUND, O. Capacitance matrix methods for the Helmholtz equation on 


general three dimensional regions. Courant Inst. Rep. COO-3077-155, New York, Oct. 1978; also 
Math. Comp. 33 (1979), 849-879. 


COLLECTED ALGORITHMS (cont.) 


BAOARGAAAOAABAAGAAGAHGAAGIADASAKBAGTHAAOAGASANAAAAGAAAGAEAANMRANAA nan nnnAnaongcNnanansna 


ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service . ] 


SUBROUTINE HELM3D (MODE, W. GG. NXDIM, NYDIM, NZDIM, IPP1, IPPe2, DELTA, NNX 
1, NNY, NNZ, NIPDIM, NAPDIM,. ICOORD, INDORD, CC, NIT. EPS, &,R,P, AP. IER) 
INTEGER MODE, NXDIM, NYDIM, NZDIM, IPP1, IPP2, NNX, NNY, NNZ.NIPDIM, TCOORD 
1¢€3, NIPDIM), INDORD(NIPDIM), NIT, IER 

REAL WC(NXDIM, NYDIM, NZDIM). GG(NXDIM, NYDIM, NZDIM), DELTACS, NIPDIM), CC 
1,EPS, S(NIPDIM), R(NIPDIM),PCNIPDIM), AP (NAPDIM) 


THIS PROGRAM WAS DEVELOPED BY DIANNE P O’LEARY AND OLOF WIDLUND. 
THIS IS VERSION. MD2, OCTOBER, 1979. 


THIS PROGRAM SOLVES THE DIRICHLET PROBLEM FOR THE 
HELMHOLTZ EQUATION OVER A GENERAL BOUNDED 3 DIMENSTONAL 
REGION IMBEDDED IN A UNIT CUBE 


~W mW - W + CCRW = GI IN THE REGION 
XX YY ZZ 


Woz F ON THE BOUNDARY 


WHERE F AND Gil ARE GIVEN FUNCTIONS GF X, Y,. AND Z. AND CC IS 

4& REAL CONSTANT. THE BOUNDARY IS ARBITRARY. THE PROGRAM 
PROVIDES A&A SOLUTION OF THE WELL KNOWN SHORTLEY-WELLER 
APPROXIMATION GF THE DIFFERENTIAL EQUATION. THE MESH TS UNIFORM 
IN EACH COORDINATE DIRECTION AND 4A SIMPLE SEVEN POINT FORMULA 

IS USED FOR INTERIOR MESH POINTS. & CAPACTTANCE MATRIX 

METHOD, WITH DISCRETE DIPOLES, IS USED. THE CAPACITANCE 
MATRIX EQUATION IS FORMULATED AS A LEAST SQUARES PROBLEM 

AND SOLVED USING THE CONJUGATE GRADIENT METHOD. 


REFERENCES: 


QO’LEARY AND WIDLUND, CAPACITANCE MATRIX METHODS 

FOR THE HELMHOLTZ EQUATION ON GENERAL 3-DIMENSTONAL 
REGIONS, NYU-DOE REPORT COQO-3077-155. OCTOBER, 1978: 
MATH. COMP. 33, 1979 849-9880. 


PROSKUROQWSKI AND WIDLUND, MATH. COMP. 30, 1976 443-468. 
ALSO NYU-DGE REPORT. 


PROSKUROWSKI,. LAWRENCE BERKELEY LAB REPORTS AND 
"NUMERICAL SOLUTION OF HELMHOLTZ’S EQUATION BY 
IMPLICIT CAPACITANCE MATRIX METHODS, " ACM TRANS. 
ON MATH. SOFTWARE 3, 1979 26-49. 


SHIEH, MRC-WISCONSIN REPORTS AND NUMER. MATH. 29 
1978 207-327. 


MACHINE DEPENDENT FEATURES: 


THIS PROGRAM SHOULD BE CONVERTED TO DOUBLE PRECISION 
IF IT IS TO BE USED ON COMPUTERS WITH SHORT WORD 
LENGTH », SUCH AS IBM 360/370. 


GENERAL DESCRIPTION OF THE PARAMETERS: 


INTEGER VALUES: 

DIMENSIONS OF ARRAYS (NXDIM, NYDIM, NZDIM, 
NIPDIM, NAPDIM) 

NUMBER OF MESH POINTS IN CUBE (NNX X NNY X 
NNZ) 

NUMBER OF POINTS IN REGION ADJACENT TO BOUNDARY 
C{IPPi. IPP2) 

MAXIMUM NUMBER OF ITERATIONS ALLOWED (NIT) 

ERROR CODE (TER) 

CODE TO CONTROL PROGRAM OPTIONS (MODE) 


REAL VALUES: 
HELMHOLTZ CONSTANT (CC) 
CONVERGENCE TOLERANCE (EPS) 
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INTEGER ARRAYS: 
COORDINATES OF POINTS IN REGION ADJACENT TO 
BOUNDARY (‘IRREGULAR POINTS’) ¢ICOORD) 
WORK SPACE (CINDORD) 


REAL ARRAYS: 
Cl VALUES (6G) 
BOUNDARY VALUES (R, P. AP) 
DISTANCES FROM IRREGULAR POINTS TO EOQUNDARY 
(DELTA) 
WORK SPACE (WwW, &) 


TOTAL ARRAY SPACE NEEDED: 


REAL: 2 MXDIM * NYDIM &® NZDIM (1 IF Gt") 
& NIPDIM 
1 MAPDIM 

INTEGER: 
4 MIVDIM 


WHERE NXDIM . GE. NNX, NYDIM . GE. NINY; 
NZDIM . GE. NNZ, 
NIPDIM . CE. IPPL + 2 * IPP2, 
NAPDIM . GE. MAX CIPPitea#IPP2, NNXENNZ, 
NNY #NNZ ) 


NOTE: 


IN THIS DOCUMENTATION, NN REFERS TO NNX, NNY, OR NNZ 
AS APPROPRIATE, AND SIMILARLY H REFERS TO HX, HY, OR HZ. 
THE MESH POINT (X,Y,Z) IS SAID TO HAVE 6 NEIGHBORS: 
CX+HX,Y,Z), (X-HX, YZ), OX. YtHY, Z), (CX, YHY, Z), 
(X,¥, Z#HZ), AND (X,Y, Z-HZ). 
& MESH POINT IS CALLED IRREGULAR IF IT IS IN THE INTERIOR OF 
THE REGION AND AT LEAST ONE OF ITS SIX NEIGHBORS IS ON OR 
OUTSIDE THE BOUNDARY. 


ON INPUT . 


MODE = 1 IF THE REGION HAS BEEN CHANGED FROM THE PREVIOUS CALL 
AND G1i=0 
IF THE REGION HAS BEEN CHANGED FROM THE PREVIOUS CALL 
AND Gi IS NONZERO 
3 IF THE REGION IS THE SAME AS ON THE PREVIOUS CALL 
AND G1=0 
4 IF THE REGION IS THE SAME AS ON THE PREVIOUS CALL 
AND G1 IS NONZERO 
3 IF THE PROBLEM IS THE SAME AS ON THE PREVIOUS CALL, 
G1i=0. AND THE ONLY CHANGE IS THAT EPS AND/OR NIT 
MAY HAVE BEEN CHANGED 
6& IF THE PROBLEM IS THE SAME 4S ON THE PREVIOUS CALL, 
Gil IS NONZERO, AND THE ONLY CHANGE IS THAT EPS 
AND/OR NIT MAY HAVE BEEN CHANGED 
IF MODE = 3.4.3, OR 5 DELTA, TCOORD, INDORD, NADI, 
NYDIM, NZDIM, NNX, NNY,  NNZ, IPPi, AND IPP2 MUST BE 
UNCHANGED FROM THE PREVIOUS CALL. THE CURRENT VALUE OF §& 
WILL BE USED AS THE INITIAL GUESS FOR THE DIPOLI STRENGTHS. 
(S=O WILL BE USED IF MODE=1 OR 2. ) 
TO IMPROVE THE ACCURACY OF A PREVIOUSLY CALCULATED SOLUTION. 
USE MODE=5 OR MODE=6 IF ROUNDOFF IS NOT SUSPECTED. IF 
ROUNDOFF IS SUSPECTED, REINITIALIZE THE BOUNDARY VALUES INR, 
AP, ANDO P, AND USE MODE = 3 TO FORCE THE RESIDUAL TO BE 
RECOMPUTED: IF Gi IS NONZERO, ADD GG TO THE SOLUTION 
RETURNED BY THE SUBROUTINE. 


Pg 


WCNXDIM, NYDIM, NZDIM) ITS UNINITIALIZED. 
GGCNXDIM, MYDIM, NZDIM) INITIALIZED TO GI#HZ#HZ IN THE 
REGION, WITH ARBITRARY VALVES OUTSIDE. 
FOR IT=1,....NWNX, J=i,...,NNY, AND Keds... NNZ, 


G6(I, U.K) CORRESPONDS TO G1(CI-1)#HX, (U-L) HY, (A-1L) #HZ) HHZ #2. 


IF MODE = 1, 3 OR 5S. Gi MAY BE A DUMMY ARRAY (I.E... 
IT NEED NOT BE DIMENSIONED BY THE CALLING PROGRAM). 


IPP1 IS THE NUMBER OF IRREGULAR POINTS WITH AT LEAST 1 
INTERIOR NEIGHBOR IN EACH DIRECTION X, Y,. AND Z. 
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~- IPP2 IS THE NUMBER OF IRREGULAR POINTS WHICH, ALONG 
AT LEAST ONE DIRECTION, HAVE TWO EXTERIOR NEIGHBORS. 


IN THE EXCEPTIGNAL CASE WHEN IPP1+IPP2.EQ@.0, THE ROUTINE 
WILL SOLVE THE PROBLEM ON THE WHOLE CUBE WITH THE 
BOUNDARY CONDITIONS# 

G1(X,Y,Z) = O Z.LT. O “OR Z.6T. 1 

W(O,Y,Z) = WO1,Y,.Z) AND WC(X,0,Z) = W(X, 1,Z) 

W(X, Y,0)=0 AND W(X, Y,Z) BOUNDED FOR ALL Z. 
ARRAY GG MUST BE INITIALIZED TO Gi#HZ#HZ AND MODE = 2. 
W MAY BE A DUMMY ARRAY. THE ANSWER WILL BE STORED 
IN THE ARRAY GG IN THIS CASE. 


-- DELTA(3, NIPDIM) RECORDS + OR ~— DISTANCE TO BOUNDARY 
FROM IRREGULAR POINT LIN THE xX, Y, AND Z 
DIRECTIONS (3#IPP1 + 6#IPP2 VALUES). THESE DISTANCES 
ARE EXPRESSED AS MULTIPLES OF THE MESH SPACING: I.E. ; 
IF A DELTA HAS THE VALUE @, THE DISTANCE IS) G+#H. 
THERE ARE THREE DELTAS FOR EACH OF THE IPP1 POINTS 
FOR L=1,IPP1, 
DELTA(1,L) = SHORTER DISTANCE TO BOUNDARY ALONG X DIRECTION 
DELTA(2,L) = SHORTER DISTANCE TO BOUNDARY ALONG Y DIRECTION 
DELTA(G, LL) = SHORTER DISTANCE TO BOUNDARY ALONG Z DIRECTION 
THERE ARE SIX DELTAS FOR EACH OF THE IPP2 POINTS, 
FOR L=1,IPP2 , LL=IPP1+2#L-1, 
DELTA(1,LL) AND DELTAC1,LL+1) ARE THE DISTANCES TO THE 
BOUNDARY ALONG THE :POSITIVE AND NEGATIVE xX DIRECTIONS 
DELTA(2,LL) AND DELTAC2,LL+1) ARE THE DISTANCES TO THE 
BOUNDARY ALONG THE POSITIVE AND NEGATIVE Y DIRECTIONS 
DELTA(3,LL) AND DELTAC(G,LL+1) ARE THE DISTANCES TO THE 
BOUNDARY ALONG THE POSITIVE AND NEGATIVE Z DIRECTIONS 
THE PROGRAM WILL INTERCHANGE DELTAS IF NECESSARY SO THAT 
FOR Lei,IPP2 , LL=IPPit+t2#l-1, 
ABS(DELTA(S,LL)) LE. ABS(DELTACS, LL+1)). 
NO DELTA CAN BE SO CLOSE TO O AS TO CAUSE OVERFLOW 
UPON DIVISION BY A PRODUCT OF TWO DELTAS. SUCH SMALL 
DELTAS SHOULD BE AVOIDED BY CHANGING THE REGION 
SLIGHTLY OR BY SHIFTING IT INSIDE THE CUBE OR BY 
USING ANOTHER MESH SIZE. 


~- NNX, NNY, NNZ ARE THE NUMBER OF MESH POINTS IN THE X, Y, AND Z 
DIRECTIONS. 
MAXCNNX, NNY) MUST BE .LE. 256 UNLESS THE ERROR CHECK IN 
HELMCK AND THE DIMENSIONS OF IB AND S IN COMMON FFT 
(SUBROUTINES CUBE, RFORT AND FORT) ARE CHANGED. 
THE MESH SPACINGS WILL BE CALCULATED TO BE 


HX = 1 7 NNX 
HY = 1 7 NNY 
HZ = | / (NNZ - 1) 


NNX AND NNY MUST BE POWERS OF 2 AND .GE. 8 UNLESS 
THE FFT ROUTINES RFORT AND FORT ARE REPLACED. 


~— NIPDIM. THE DIMENSION OF THE ONE DIMENSIONAL ARRAYS, 
MUST BE .GE. IPP1+2*IPP2. 
~~ NWAPDIM » THE DIMENSION OF AP . MUST 
BE . GE. MAX CIPPI+2#IPP2, NNX#NNZ, NNY#NNZ ). 
-~ ICOORD(3,NIPDIM) RECORDS THE S#(IPP1I+IPP2) INDICES OF 
THE IRREGULAR POINTS. THESE INDICES MUST LIE BETWEEN 
2 AND NN-1 INCLUSIVE. 
FOR &L = 1, IPP1 
THE L-TH COLUMN OF ICOORD 
GIVES THE INDICES CORRESPONDING 
TO DATA IN THE L-TH COLUMNS OF 
DELTA, P. R. AND AP. 
FOR L = i, IPP2, LL = IPPi1 +2a2*t- i 
THE CIPPi+lL)-TH COLUMN OF ICOORD 
GIVES THE INDICES CORRESPONDING TO 
DATA IN THE LL~-TH AND (LL+1)-TH 
COLUMNS OF DELTA, P., R, AND AP. 
~~ INDORD (NIPDIM) I5 UNINITIALIZED. THE PROGRAM WILL 
RECORD A CODE (1-6) FOR THE ORDER OF THE DELTAS. 
-~ CC IS THE CONSTANT IN THE HELMHOLTZ EQUATION. 
“— NIT IS THE MAXIMUM NUMBER OF CONJUGATE GRADIENT ITERATIONS 
ALLOWED. 
-- EPS IS THE TOLERANCE FOR THE EUCLIDEAN NORM OF 
THE CAPACITANCE EQUATION RESIDUAL DIVIDED BY THE 
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SQ@RT OF THE DIMENSION OF THIS VECTOR. 

TT T T 
RESIDUAL = C UF - € C S&S WHERE C = U AGYV . 
IT IS DIFFICULT TO GIVE A RELIABLE RULE OF 
THUMB FOR THE CHOICE OF EPS. FOR MANY PROBLEMS 
ONE TENTH OF THE DESIRED ACCURACY FOR THE 
SOLUTION OF THE ORIGINAL DISCRETE PROBLEM IS A 
SUITABLE VALUE. A SMALLER TOLERANCE IS REQUIRED 
WHEN THE DISCRETE HELMHOLTZ OPERATOR IS CLOSE 
TO SINGULAR. 


-- GS. Ps. R ARE OF DIMENSION NIPDIM . 


AP IS OF DIMENSION NAPDIM 

S IS UNINITIALIZED IF MODE = 1 OR 2. 

IF MODE .LT. 5, FOR L=1, IPP1+2#IPP2, 

R¢(L) «& FCX+DELTAC1,L)#HX, Y, 2) 

P(L) = F(X, Y+DELTA(2,L)#HY, 2) 

AP(L) = F(X, Y, Z+DELTACG, L)#HZ) 
WHERE X,Y, AND Z ARE THE COORDINATES CF THE 
IRREGULAR POINT CORRESPONDING TO THE DELTAS. 
THE VALUES OF RR, P. AND AP ARE NOT USED IN THE 
COMPUTATION IF THE ABSOLUTE VALUE OF THE CORRESPONDING 
DELTA IS GREATER THAN 1. 


TER IS UNINITIALIZED. THE PROGRAM WILL RECORD AN ERROR 

CODE (0-3). 

THE USE OF DISCRETE DIPOLES IMPOSES A MILD RESTRICTION 

ON THE GEOMETRY OF THE REGION. THE THREE MESH POINTS, OBTATNED 
BY STEPPING FROM AN IRREGULAR POINT IN THE DIRECTION OF THF 
SMALLEST MAGNITUDE DELTA, FROM THIS NEW POINT IN 

THE DIRECTION OF THE MEDIUM, AND FROM THERE IN THE DIRECTION 
OF THE LARGEST MUST NOT BE INTERIOR POINTS OF THE REGION. 
ASSOCIATED WITH AN IRREGULAR POINT WHICH HAS AT 

LEAST 2 EXTERIOR NEIGHBORS IN SOME MESH 

DIRECTION ARE TWO COLUMNS OF THE ARRAY DELTA 

THE DELTA’S RELEVANT TO THIS TEST ARE THE 

SMALLER IN MAGNITUDE OF THE TWO POSSIBLE 

CHOICES IN EACH COORDINATE DIRECTION. IF THE 

RESTRICTION IS VIGLATED, A SUBROUTINE HELMCK WILL RETURN AN 
ERROR FLAG IER = 2. A REFINEMENT OF THE MESH OR 

A SLIGHT SHIFT OF THE REGION IN THE UNIT CUBE MIGHT 

RESOLVE THE PROBLEM. 


ON OUTPUT . 


W WILL CONTAIN VALUES OF THE SOLUTION INSIDE THE 
REGION AND USELESS VALUES OUTSIDE AND ON THE 
BOUNDARY. 

S WILL RECORD DIPOLE STRENGTHS. THIS 1S THE SOLUTION 
VECTOR OF THE CAPACITANCE MATRIX EQUATION. 

R WILL BE THE RESIDUAL OF THE CAPACITANCE EQUATION. 


P >, AP; AND GG WILL BE. CHANGED, AND THE DELTAS MAY 
BE REORDERED AS INDICATED ABOVE. 


ERROR RETURNS: 


IER=0 NO ERROR 
=] ERROR IN INTEGER PARAMETER 
ard ERROR IN ICOORD OR VIOLATION OF DIPOLE 
RESTRICTION QR IRREGULAR POINT MISSING 
=3 TOO MANY CONJUGATE GRADIENT ITERATIONS 


WITHOUT CONVERGENCE. ANSWER DOES NOT 
HAVE THE REQUESTED ACCURACY. 


AFTER EACH ITERATION, THE FOLLOWING INFORMATION IS PRINTED: 
—- THE CONJUGATE GRADIENT PARAMETERS ALPHA AND BETA. 
THIS INFORMATION COULD BE USED TO ESTIMATE THE 
CONDITION NUMBER OF THE CAPACITANCE MATRIX 
-- THE EUCLIDEAN NORM OF THE RESIDUAL OF THE 
CAPACITANCE MATRIX EQUATION. 
TY T T 
THE RESIDUAL=C VU F-C CS WHERE C= U AGV. 


THE ROLES OF THE SUBROUTINES: 


HELM3D CONTROLS THE CONJUGATE GRADIENT ITERATION. 
HELMCK CHECKS THE INPUT DATA FOR CORRECTNESS. 
VMULT USES THE DIPOLE STRENGTHS IN A NIPDIM ARRAY TO 
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VTRANS 


UTAMLT 


UTATRN 


BNDRY 


CUBE 


RFORT 


FORT 


SET UP THE DIPOLES IN A 3 DIMENSIONAL ARRAY. 

THIS SUBROUTINE THUS DEFINES A LINEAR MAPPING 

FROM A SPACE OF I1I-DIMENSIGNAL ARRAYS TO A SPACE 

OF 3-DIMENSIONAL ARRAYS. 

DEFINES THE TRANSPOSE OF THE MAPPING DEFINED 

BY VMULT. 

MAPS 3-DIMENSIONAL ARRAYS INTO 1-DIMENSTONAL 
ARRAYS BY USING A FINITE DIFFERENCE FORMULA WHICH 
CORRESPONDS TO A PART OF THE SHORTLEY-WELLER 

APPROX IMATION. THE REMAINING PART IS HANDLED BY 
BNDRY. 

DEFINES THE TRANSPOSE OF THE MAPPING DEFINED BY 
UTAMLT. 

PROCESSES THE DIRICHLET DATA AND THE VALUES OF GJ 
CLOSE TO THE BOUNDARY, PRODUCING UC(TRANSPOSE)F FOR 
USE IN THE RIGHT HAND SIDE OF THE CAPACITANCE EQUATION 
SOLVES THE HELMHOLTZ EQUATION OVER A CUBE USING A 
FOURIER-TOEPLITZ ALGORITHM. 

IS A FAST FOURIER TRANSFORM ROUTINE DUE TO 

W. PROSKUROWSKI WHO REVISED A CODE WRITTEN BY J. CONILEY 
IT IS USED BY SUBROUTINE CUBE. 

IS A SUBROUTINE CALLED BY RFORT. 
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ALGORITHM 573 
NL2SOL—aAn Adaptive Nonlinear 
Least-Squares Algorithm [E4] 


JOHN E. DENNIS, JR. 

Rice University 

and 

DAVID M. GAY and ROY E. WELSCH 
Massachusetts Institute of Technology 


Key Words and Phrases: unconstrained optimization, nonlinear least squares, nonlinear 
regression, quasi-Newton methods, secant methods 

CR Categories: 5.14, 5.5 

Language: FORTRAN 


1. PURPOSE 
Given a continuously differentiable function (residual vector) R(x) = (Ri(x), 
R2(x), ..., Ra(x))" of p parameters x = (x1, X2,..., Xp)", NL2SOL attempts to 


find a parameter vector x* that minimizes the sum-of-squares function F(x) = 
Wy Ri(x)’. 


2. METHOD 


Reference [1] explains the algorithm realized by NL2SOL in detail. The algorithm 
amounts to a variation on Newton’s method in which part of the Hessian matrix 
is computed exactly and part is approximated by a secant (quasi-Newton) 
updating method. Once the iterates come sufficiently close to a local solution, 
they usually converge quite rapidly. To promote convergence from poor starting 
guesses, NL2SOL uses a model/trust-region technique along with an adaptive 
choice of the model Hessian. Consequently, the algorithm sometimes reduces to 
a Gauss-Newton or Levenberg-Marquardt method. On large residual problems 
(in which F'(x*) is large), however, NL2SOL often works much better than these 
methods. 
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3. DESCRIPTION 


3.1 Calling Sequence 
CALL NL2SOL (N, P, X, CALCR, CALCJ, IV, V, UIPARM, URPARM, UFPARM) 


Note: NL2SOL is written in American National Standard FORTRAN (1966) and 
the comments below assume that the calling program is also written in FOR- 
TRAN. These comments refer to the single-precision version of NL2SOL. In the 
double-precision version, all quantities termed REAL, below are actually DOU- 
BLE PRECISION. 


N 


CALCR 


CALCJI 


IV 


UIPARM 


URPARM 


(input INTEGER) is the number of components in the residual 
vector R. 

(input INTEGER) is the number of parameters on which R# depends. 
(I/O REAL array of length P) on input is an initial guess at the 
desired solution x*. When NL2SOL returns, X contains the best 
parameter estimate found so far. 

(input subroutine) computes the residual vector R = R(X) when 
invoked by 


CALL CALCR(N, P, X, NF, R, UIPARM, URPARM, UFP.ARM) 


When CALCR is called, NF is the invocation count for CALCR; it is 
included for possible use with CALCJ. If X is out of bounds (e.g., if 
R(X) would overflow), then CALCR should set NF to 0, which will 
cause a shorter step to be attempted. CALCR should not change N, 
P, or X and should be declared EXTERNAL in the calling program. 
R should be declared REAL R(N). 

(input subroutine) computes the Jacobian matrix J = J(X) of first 
partials, Ji; = dJi(X)/dx;, when invoked by 


CALL CALCJ(N, P, X, NF, J, UIPARM, URPARM, UFPARM) 


When CALC is called, NF is the invocation count for CALCR at the 
time when R(X) was evaluated. The X passed to CALCJ is usually 
the one passed to CALCR on either its rnost recent invocation or the 
one prior to it. Thus if CALCR saves intermediate results for use by 
CALCZJ, then it is possible to tell from NF whether they are valid for 
the current X (or which copy is valid if two are kept). If J cannot be 
computed at X, then CALCJ should set NF to 0. CALCJ should not 
change N, P, or X and should be declared EXTERNAL in the calling 
program. J should be declared REAL J(N, P). 

(I/O INTEGER array of length P + 60) on input contains certain 
values (such as limits on the number of iterations and calls on 
CALCR) that control the behavior of NL2SOL and on output con- 


tains various counts and other items of interest: see Sections 3.3 and- 


3.4. If [V(1) = 0 on input, then default values are supplied for the 
input components of both IV and V. The caller may supply nondefault 
values for selected components of IV and V by CALLing 
DFAULT(IV, V) and then assigning the appropriate nondefault 
values before calling NL2SOL. 

(I/O REAL array of length 93 + N(P + 3) + P(8P + 33)/2) on input 
contains certain values (such as convergence tolerances) that control 
the behavior of NL2SOL and on output contains various items of 
interest (such as F(X) and R(X)): see Sections 3.5 and 3.15. 
(INTEGER array of length determined by the caller) is passed 
without change to CALCR and CALCJ and may be used by them in 
any way that the caller may find convenient. . 

(REAL array of length determined by the caller), like UIPARM, is 
passed without change to CALCR and CALCJ. 
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UFPARM (subroutine), like UIPARM, is passed without change (and without 
having been invoked) to CALCR and CALCU. If there is no need for 
such a subroutine, then on many systems it suffices to pass an 
arbitrary variable or constant for UFPARM. But if an actual subrou- 
tine is passed, then it must be declared EXTERNAL in the calling 
program. 


3.2 Example 
Let n = 3, p = 2, and 


x2 + x8 + 01x02 
R(x) = sin X1 , 


COS X2 


(This problem is due to Madsen [3].) The following FORTRAN code minimizes 
F(x) = 4R(x)"R (x), starting from the initial guess (3, 1)", using a single-precision 
version of NL2SOL. 


INTEGER IV(62), UI(1) 

REAL V(147), X(2), UR(1) 

EXTERNAL MADR, MADJ 

X(1) = 3.0 

X(2) = 1.0 

IV(1) =0 

CALL NL2SOL (3, 2, X, MADR, MADJ, IV, V, UI, UR, MADR) 
STOP 

END 

SUBROUTINE MADR (N, P, X, NF, R, UI, UR, UF) 
INTEGER N, P, NF, UI(1) 

REAL X(P), R(N), UR(1) 

EXTERNAL UF 

R(1) = X(1)**2 + X(2)**2 + X(1)*X(2) 

R(2) = SIN(X(1)) 

R(3) = COS(X(2)) 

RETURN 

END 

SUBROUTINE MAD (N, P, X, NF, J, UI, UR, UF) 
INTEGER N, P, NF, UI(1) 

REAL X(P), J(N, P), UR(1) 

EXTERNAL UF 

J(1, 1) = 2.0*X(1) + X(2) 

J(1, 2) = 2.0*X(2) + X(1) 

J(2, 1) = COS(X(1)) 

J(2, 2) = 0.0 

J(3, 1) = 0.0 

J(3, 2) = —SIN(X(2)) 

RETURN 

END 


The main program above passes MADR as CALCR and MADJ as CALCJ. No 
use is made of UIPARM, URPARM, or UFPARM in this simple example. 

When the above is executed, NL2SOL prints the initial X vector, asummary of . 
the iterations performed, the final X vector, and some statistics, including the 
final F(X) and a covariance matrix. If, REAL is changed to DOUBLE PRECI- 

' SION and the above is run on an IBM 370 computer, then NL2SOL reports 

relative function convergence (IV(1) = 4—see Section 3.3) after 12 calls on 
MADR and MADJ and returns X(1) = —0.155437, X(2) = 0.694564, and F(X) = 
0.386600. ; 

If, say, we wanted to suppress the iteration summary, we could do so by 
replacing the statement IV(1) = 0 in the main program by 


CALL DFAULT(IV, V) 
IV(19) = 0 


(See the description of IV(OUTLEV) in Section 3.4.) 


COLLECTED ALGORITHMS (cont.) 573-P 4- 0 


3.3 Return Codes 
When NL2SOL returns, IV(1) contains one of the following return codes: 


3 = X-convergence. The scaled relative difference between the 
current parameter vector X and a locally optimal parameter x* 
is very likely at most V(XCTOL): see Section 3.5. 

4 = relative function-convergence. The relative difference between 
the current function value and its locally optimal value is very 
likely at most V(RFCTOL): see Section 3.5. 


5 = both X and relative function-convergence, that is, the condi- 
tions for [V(1) = 3 and IV(1) = 4 both hold. 

6 =absolute function-convergence. The current function value 
(half the sum of squares) is at most V(AFCTOL): see Section 
3.5. 

7 = singular convergence. The Hessian near the current X appears 


to be singular or nearly so, and a step of scaled length at most 
V(LMAX0) is unlikely to yield a relative function decrease of 
more than V(RFCTOL). This means that the model is over- 
specified (i.e., contains too many parameters), at least near X. 
It is possible that a different starting guess would lead NL2SOL 
to find an X giving a smaller F(X) and strong convergence 
(IV(1) = 3, 4, 5, or 6). 

8 = false convergence. The iterates appear to be converging to a 
noncritical point. This may mean that the false convergence 
tolerance (V(XFTOL)—see Section 3.5) is too large, that the 
convergence tolerances (V(AFCTOL), V(RFCTOL), 
V(XCTOL)) are too small for the accuracy to which CALCR 
and CALCJ compute R and J, that there is an error in com- 
puting the Jacobian matrix J, or that R is discontinuous near 
X. 

If the NPRELDF value printed in the summary statistics (or 
in the iteration summary for the final iteration) is negative and 
not too much larger than V(RFCTOL) in absolute value, then 
V(RFCTOL) is too small and singular convergence would be 
detected if V(RFCTOL) were increased above | NPRELDF |: 
see Sections 3.5 and 3.11. 


9 = function evaluation limit reached without other convergences: 

see LV(MXFCAL) in Section 3.4. 

10 =iteration limit reached without other convergence: see 
IV(MXITER) in Section 3.4. 

11 = STOPX returned .TRUE. (external interrupt): see Section 3.14. 

13 = F(X) cannot be computed at the initial X. 

14 = bad parameters passed to ASSESS. (This should not occur.) 

15 =the Jacobian could not be computed at X (see CALCJ above). 

16 =N or P (or parameter NN to NL2ITR) out of range: P < 0 or 
N<PorNN<N. 

17 =a restart was attempted with N, P, or parameter NN to 
NL2ITR changed: see Section 3.7. 

18 =IV(INITS) out of range: see Section 3.4. 

19-45 = V(IV(1)) is out of range. 

50 =IV(1) was out of range when NL2SOL (or NL2SNO or 


NL2ITR) was called. 
87... (86+ P) =JTOL(IV(1)-86), that is, V(IV(1)), is not positive: see V(DFAC) 
in Section 3.5. 


Just before NL2SOL returns, a brief description of the return code is printed 
(unless all printing is turned off by IV(PRUNIT) = 0). 
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3.4.1 IV Input Values (Supplied by DFAULT) 


IV(1) ... IV(1) should have a value between 0 and 12 when NL2SOL is called. 0 
and 12 both mean that this is a fresh start; 0 means DFAULTI(IV, V) should be 
invoked to supply default values to the input components of IV and V, while 12 
(the value that DFAULT assigns to IV(1)) means that the caller has already 
called DFAULT(IV, V) and has. possibly changed some IV or V entries to 
nondefault values. IV(1) input values between 3 and 11 mean that NL2SOL 
should restart; see Section 3.7. Default = 12. 


IV(COVPRT) ... IV(14) = 1 means print a covariance matrix at the solution. 
This matrix is computed as IV(COVREQ) dictates just before a return 
with IV(1) = 3, 4, 5, or 6. IV(COVPRT) = 0 means skip this printing. Default 
= 1, 

IV(COVREQ): IV(15) * 0 means compute a covariance matrix before a return 
with IV(1) = 3, 4, 5, or 6. In this case, an approximate covariance matrix is 
obtained in one of several ways. Let k = | IV(COVREQ) | and let o = 2F(X)/ 
max (1, N—P), where 2F(X) is the residual sum of squares. If k = 1 or 2, then 
a finite-difference Hessian approximation H is obtained. If H is positive-definite 
(or, for k = 3, if the Jacobian has full rank), then one of the following is 
computed: 


k=1=>o0H''\(J'J)H"' 
k=2=>o0H™ 
k=3=>a0(J'J)". 


If [V(COVREQ) > 0, then both function and gradient values (calls on CALCR 
and CALCJ) are used in computing H (with step sizes determined by 
V(DELTAO); see Section 3.5), while if IV(COVREQ) < 0, then only function 
values (calls on CALCR) are used (with step sizes determined by V(DLTFDC)). 
If IV(COVREQ) = 0, then no attempt is made to compute a covariance matrix 
(unless I[V(COVPRT) = 1, in which case NL2SOL assumes IV(COVREQ) = 1 
and NL2SNO assumes IV(COVREQ) = —1). See IV(COVMAT) below. Default 
= 1. 


IV(DTYPE) ... IV(16) tells how the scale vector D (see [1]) should be chosen. 
IV(DTYPE) > O means choose D as described below with V(DFAC). 
IV(DTYPE) < 0 means the caller has chosen D and has stored it in V starting 
at V(94 + 2N + P(38P + 31)/2). Default = 1. 


IV(INITS) ... IV(25) tells how the S matrix (see [1]) should be initialized. 0 
means initialize S to all zeros and start with the Gauss-Newton model. 1 and 
2 mean that the caller has stored the lower triangle of the initial S rowwise in 
V starting at V(87 + 2P). IV(INITS) = 1 means start with the Gauss-Newton 
model, while IV(INITS) = 2 means start with the augmented model; see [1]. 
Default = 0. 


IV(MXFCAL) ... IV(17) gives the maximum number of function evaluations 
(calls on CALCR, excluding those used to compute the covariance matrix and, 
in the case of NL2SNO, the Jacobian matrices) allowed. If this number does 
not suffice, then NL2SOL returns with IV(1) = 9. Default = 200. 


IV(MXITER) .. . IV(18) gives the maximum number of iterations allowed. It also 
indirectly limits the number of gradient evaluations (calls on CALCJ) to 
IV(MXITER) + 1. If IV(MXITER) iterations do not suffice, then NL2SOL 
returns with IV(1) = 10. Default = 150. 


IV(OUTLEV) ... IV(19) controls the number and length of iteration summary 
lines printed (by ITSMRY). IV(OUTLEV) = 0 means do not print any 
summary lines. Otherwise print a summary line after each |IV(OUTLEV) | 
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iterations. Long summary lines are printed if IV(OUTLEV) > 0, short lines if 
IV(OUTLEV) < 0. See Section 3.11 for more details. Default = 1. 


IV(PARPRT) ... IV(20) = 1 means print any nondefault V values on a fresh 
start or any changed V values on a restart. [V(PARPRT) = 0 means skip this 
printing. Default = 1. 


IV(PRUNIT) ...IV(21) is the output unit number on which all printing is done. 
IV(PRUNIT) = 0 means suppress all printing. (Setting IV(PRUNIT) to 0 is 
the only way to suppress the one-line termination message printed before 
NL2SOL returns.) Default = standard output unit (unit 6 on most systems); 
the default for IV(PRUNIT) is actually IMDCON(1); see Section 3.12. 


IV(SOLPRT) ... IV(22) = 1 means print the final X (the one returned), along 
with the final gradient and scale vector D. IV(SOLPRT) = 0 means skip this 
printing. Default = 1. 


IV(STATPR) ... IV(23) = 1 means print summary statistics upon returning. 
These consist of the function value (half the residual sum of squares) at X, the 
scaled relative size of the last step taken (see V(RELDX) below),. the number 
of function and gradient evaluations (calls on CALCR and CALCJ, excluding 
any calls made only for computing covariance matrices), the relative function 
reductions predicted for the last step taken and for a Newton step (or perhaps 
a step of length bounded by V(LMAX0)—see the descriptions of PRELDF and 
NPRELDF in Section 3.11 below), and, if an attempt was made to compute a 
covariance matrix, the number of calls on CALCR and CALCJ used in trying 
to compute the covariance matrix. IV(STATPR) = 0 means skip this printing. 
Default = 1. 


IV(XOPRT) ... [V(24) = 1 means print the initial X and scale vector D (on a 
fresh start only). IV(XOPRT) = 0 means skip this printing. Default = 1. 


3.4.2 IV Output Values of Primary Interest 
IV(1) ... IV(1) is the return code; see Section 3.3. 


IV(COVMAT) ... IV(26) tells whether a covariance matrix was computed. If 
IV(COVMAT) > 0, then the lower triangle of the covariance matrix is stored 
row-wise in V, starting at V(IV(COVMAT)). If IV(COVMAT) = 0, then no 
attempt was made to compute a covariance matrix. If IV(COVMAT) = —1, 
then the finite-difference Hessian H was indefinite (or, for | IV(COVREQ) | = 
3, the current Jacobian matrix is rank deficient): like singular convergence (see 
Section 3.3), this may mean that the model is overspecified (contains too many 
parameters). And if IV(COVMAT) = —2, then a successful finite-difference 
step could not be found for some component of X (i.e., CALCR set NF to 0 for 
each of two trial steps). 

Note that IV(COVMAT) is reset to 0 after each successful step, so if such a 
step is taken after a restart, then the covariance matrix will be recomputed. 


IV(D) ...IV(27) is the starting subscript in V of the current scale vector D. 


IV(G) ...1V(28) is the starting subscript in V of the current least-squares gradient 
vector J'R. 


IV(NFCALL) ... IV(6) is the number of calls so far made on CALCR (i.e., 
function evaluations, including those used in computing covariance matrices). 


IV(NFCOV) ...IV(40) is the number of calls made on CALCR when computing 
covariance matrices. 


IV(NGCALL) ... [V(30) is the number of calls on CALCJ (gradient evaluations) 
so far made, including those used in computing covariance matrices. 
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IV(NGCOV) ...IV(41) is the number of calls made on CALCJ when computing 
covariance matrices. 


IV(NITER) ... IV(81) is the number of iterations performed. 


IV(R) ...IV(50) is the starting subscript in V of the residual vector R correspond- 
ing to the final X. 


3.5 V Values of Primary Interest 


Many of the V input components described here and in Section 3.15 must lie in 
certain intervals. If such a component lies outside the interval indicated for it 
below (or in Section 3.15) at the beginning of its description, then module 
PARCHK will print an error message (unless IV(PRUNIT) = 0) and will force 
NL2SOL to return immediately with IV(1) > 18. 

Frequent reference is made below to two quantities: MACHEP and the scale 
vector D. MACHEP is the unit roundoff for the floating-point arithmetic being 
used—see Section 3.12. The scale vector D is the diagonal of the diagonal scale 
matrix D, discussed in [1, Sections 5 and 7]; this scale matrix is denoted by 
diag(D) below. 


3.5.1 V Input Values of Primary Interest (Supplied by DFAULT) 


V(AFCTOL) ... V(31) > 0 is the absolute function convergence tolerance. If 
NL2SOL finds a point where the function value (half the sum of squares) is 
less than V(AFCTOL), and if NL2SOL does not return with IV(1) = 3, 4, or 5, 
then it returns with IV(1) = 6. 


Default = max{10-” , MACHEP’}. 


V(DELTAO) ... V(44) © [MACHEP, 1] is a factor used in choosing the finite- 
difference step sizes used in computing covariance matrices when IV(COVREQ) 
= 1 or 2. For differences involving X(z), step size 


V(DELTAO) -max{ | X(i) |, 1/D(i)} - sign(X(z)) 


is used, where D is the current scale vector; see [1]. If this results in CALCR 
setting NF to 0, then —0.5 times this step is also tried. Default = MACHEP””. 


V(DFAC) ... V(41) € [0, 1] and the DO and JTOL arrays (see V(DOINIT) and 
V(JTINIT)) are used in updating the scale vector D when IV(DTYPE) > 0. 
(D is initialized according to V(DINIT).) Let 


D1(i) = max{{JCNORM(i)? + max{Si, 0}]’’, V(DFAC)D(i)}, 


where JCNORM(i) is the 2-norm of the ith column of the current Jacobian 
matrix and S is the S matrix of [1]. If V(DTYPE) = 1, then D(z) is set to D1(z) 
unless D1(z) < JTOL(2), in which case D(z) is set to max{(D0(z), JTOL(z)}. If 
IV(DTYPE) > 1, then D is updated during the first iteration as for IV(DTYPE) 
= 1 (after any initialization due to V(DINIT)) and is left unchanged thereafter. 
Default = 0.6. 


V(DINIT) ... V(38) = —10: if V(DINIT) = 0, then it is the value to which all 
components of the scale vector D are initialized during a fresh start. Default 
= 0. 


V(DLTFDC) ... V(40) € [MACHEP, 1] helps choose the step sizes used in 
computing covariance matrices when IV(COVREQ) = —1 or —2. For differences 
involving X(i), the step size first tried is 


V(DLTFDC)- max{| X(z) |, 1/D@}, 


where D is the current scale vector (see [1]). If this step is too big the first time 
it is tried, that is, if CALCR sets NF to 0, then —0.5 times this step is also tried. 
Default = MACHEP”™. 
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V(DLTFDJ) ... V(36) € [MACHEP, 1] helps choose the step sizes used when 
NL2SNO computes a finite-difference approximation to the Jacobian matrix. 
For differences involving X(i), the step size first tried is 


V(DLTFDJ)-max{ | X(z) |, 1/D(@}, 


where D is the current scale vector (see [1]). If the first step is too big, that is, 
if CALCR sets NF to 0, then smaller steps are tried until the step size is shrunk 
below 1000 - MACHEP. Default = MACHEP””. 


V(DOINIT) ... V(37) = 0: if V(DOINIT) > 0, it is the value to which all 
components of the DO vector (see V(DFAC)) are initialized. If V(DOINIT) = 0, 
then it is assumed that the caller has stored DO in V starting at V(P + 87). 
Default = 1.0. 


V(JTINIT) ... V(39) = 0: if V(JTINIT) > 0, it is the value to which all 
components of the JTOL array (see V(DFAC)) are initialized. If V(JTINIT) 
= 0, then it is assumed that the caller has stored JTOL in V starting at V(87). 
Default = 107°. 


V(LMAX0) ... V(35) > 0 gives the maximum 2-norm allowed for diag(D) times 
the very first step that NL2SOL attempts. It is also used in testing for singular 
convergence: if the function reduction predicted for a step of length bounded 
by V(LMAXO0) is at most V(RFCTOL) | Fo|, where Fo is the function value at 
the start of the current iteration, and if NL2SOL does not return with IV(1) 
= 3, 4, 5, or 6, then it returns with IV(1) = 7. Default = 100. 


V(RFCTOL) ... V(32) € [MACHEP, 0.1] is the relative function-convergence 
tolerance. If the current model predicts a maximum possible function reduction 
(see V(NREDUC)) of at most V(RFCTOL) | Fo|, where Fo is the function value 
at the start of the current iteration, and if the last step attempted achieved no 
more than twice the predicted function decrease, then NL2SOL returns with 

IV(1) = 4 (or 5). Default = max{107!°, MACHEP?””}. 


V(TUNERI) ... V(26) € [0, 0.5] helps decide when to check for false convergence 
and to consider switching models. This is done if the actual function decrease 
from the current step is no more than V(TUNER1) times its predicted value. 
Default = 0.1. 


V(XCTOL) ... V(33) € [0, 1] is the X-convergence tolerance. If a Newton step 
(see V(NREDUC)) is tried that has V(RELDX) <= V(XCTOL) and if this step 
yields at most twice the predicted function decrease, then NL2SOL returns 
with IV(1) = 3 (or 5). Default = MACHEP’”. 


V(XFTOL) ... V(34) € [0, 1] is the false-convergence tolerance. If a step is tried 
that gives no more than V(TUNERI) times the predicted function reduction 
and that has V(RELDX) <= V(XFTOL), and if NL2SOL does not return with 
IV(1) = 3, 4, 5, 6, or 7, then it returns with IV(1) = 8. (See the description of 
V(RELDX) below.) Default = 100-MACHEP. 


V(*) ... DFAULT supplies to V a number of tuning constants, with which it 
should normally be unnecessary to tinker. See ‘Section 3.15. 
3.5.2 V Output Values of Primary Interest 


V(DGNORM) ... V(1) = || diag(D)~"g ||2, where g is the most recently computed 
gradient and D is the corresponding scale vector. 


V(DSTNRM) ... V(2) = || diag(D)Ax || 2, where A>: is the most recently computed 
step and D is the current scale vector. 


V(F) ... V(10) is the current function value (half the residual sum of squares). 
V(FO) ... V(18) is the function value at the start of the current iteration. 
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V(NREDUC) ... V(6), if positive, is the maximum function reduction possible 
according to the current model, that is, the function reduction predicted for a 
Newton step: Ax = —H™'g, where g = J'R is the current gradient and H is the 
current Hessian approximation: 


H=J'J for the Gauss-Newton model 
H=J'J+S for the augmented model. 
V(NREDUC) = 0 means H is not positive definite. 


If V(NREDUC) < 0, then V((NREDUC) is used in the singular convergence 
test: It is the negative of the function reduction predicted for a step computed 
with a step bound of V(LMAX0). 


V(PREDUC) ... V(7) is the function reduction predicted (by the current quad- 
ratic model) for the current step. This (divided by V(FO)) is used in testing for 
relative function convergence. 


V(RADIUS) ... V(8) is the trust region radius (i.e., step bound) used for the last 
step tried. 


V(RELDX) ... V(17) is the scaled relative change in X caused by the current 
step, Ax, computed as 


max{ | D(z)[X(i) — Xo(é)]|}/max{DW[| X@ | + | Xo) |B, 


where X = Xo + Ax. 


3.6 Finite-Difference Jacobians: NL2SNO 


Those who do not wish to code a subroutine CALCJ for (analytically) computing 
the Jacobian matrix may avoid doing so by calling NL2SNO instead of NL2SOL. 
NL2SNO computes an approximate Jacobian matrix by forward differences 
(using a step size determined by V(DLTFDJ)—see Section 3.5). The calling 
sequence for NL2SNO amounts to the one for NL2SOL with CALCJ omitted: 


CALL NL2SNO (N, P, X, CALCR, IV, V, UIPARM, URPARM, UFPARM) 


The parameters for NL2SNO are the same as the corresponding ones for 
NL2SOL, with the minor exception of IV(COVREQ): If IV(COVPRT) = 1 and 
IV(COVREQ) = 0, then NL2SNO sets IV(COVREQ) to —1; otherwise, it sets 
IV(COVREQ) to — | IV(COVREQ) |. Thus NL2SNO uses function values only in 
computing covariance matrices and V(DELTAQO) is not used. 


3.7 Restarting 


After any return with 3 = IV(1) S 11, it is possible to change some of the IV and 
V input components (such as the convergence tolerances and the iteration and 
function evaluation limits) and call NL2SOL (or NL2SNO) again with IV(1) 
unchanged. This causes the algorithm to be resumed at the point where it was 
interrupted. (It is even possible to save IV, V, and X and then restart in a 
subsequent run.) 


3.8 Scaling 


Problems sometimes arise that are poorly scaled in the sense that the various 
components of X are expressed in widely differing units. With the default choice 
of the scale vector D (see V(DFAC) and the beginning of Section 3.5), the 
behavior of NL2SOL is largely insensitive to this kind of poor scaling. On well- 
scaled problems, the performance of NL2SOL can sometimes be improved by 
choosing D to be a vector of ones, that is, by setting IV(DTYPE) to 0 and 
V(DINIT) to 1.0. Occasionally it may also be worthwhile to fix D(z), 1 <i = P, at 
the 2-norm of the ith column of the initial Jacobian matrix by setting [V(DTYPE) 
to 2. 
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3.9 LMAXO: The Initial Step Bound 


On some problems it is necessary to give V(LMAX0) = V(35) a small value to 
prevent a disasterously large first step, one that might result in exponent overflow 
or arguments out of range to intrinsic functions. Even if no disaster occurs, if 
NL2SOL takes a number of function evaluations on the first iteration, then this 
number can be reduced on subsequent reruns by setting V(LMAX0) to the value 
in the D*STEP column of the iteration summary for iteration 1. 


3.10 Local Solutions 


It can easily happen that NL2SOL only finds a local minimizer of the sum-of- 
squares function F(X) and that a different starting guess would cause a point to 
be found at which F has a still smaller value. Except for cases where special 
conditions (such as convexity of the objective function) prevail, this shortcoming 
is shared by all minimization algorithm implementations. 


3.11 Printed Output 


Any printing is done by one of two modules: ITSMRY and PARCHK. PARCHK 
reports any V input components that are out of range and optionally lists any 
such components that have nondefault or changed values (on a fresh start or 
restart, respectively). ITSMRY does the remaining printing. Various IV input 
components control what printing is done; see Section 3.4. 

If IV(OUTLEV) > 0, then ITSMRY produces an iteration summary which 
includes the following values: IT, the current iteration number; NF, the number 
of function evaluations (calls on CALCR), excluding any extra ones needed for 
computing covariance matrices and, in the case of NL2SNO, excluding the extra 
ones needed to compute finite-difference Jacobian matrices; F, the current 
function value (half the residual sum of squares); RELDF, the relative difference 
between the previous and the current function value (i.e., the difference in 
function values divided by the previous function value); PRELDF, the value of 
RELDF predicted by the quadratic model used to compute the step just taken; 
RELDX, the relative change in X caused by the step just taken—-see V(RELDX) 
in Section 3.5; MODEL, a code that tells which models were usec in choosing the 
current step (G = the Gauss-Newton model; S =: the augmented model; G-S 
means the Gauss—Newton model was tried first and a switch was then made to 
the augmented model; S-G, G-S-G, and S-G-S have analogous meanings); 
STPPAR, the Marquardt parameter 4 for the last step, Ax, computed: A > 0 
means Ax satisfies 

[H + Ad diag(D)*]Ax = —g, 


where H and g are the old Hessian approximation and gradient, respectively (the 
ones used in computing the step just taken); SIZE, the sizing factor used in 
updating the S matrix (see [1]); D*STEP, the 2-norm of diag(D) times the step 
just taken (see V(DSTNRM) in Section 3.5); and NPRELDF: if NPRELDF > 0, 
then it is the relative function reduction (i.e., value of RELDF) predicted for a 
full Newton step; if NPRELDF = 0, then the Hessian approximation failed to be 
positive definite; and if NPRELDF < 0, then it is the negative of the relative 
function reduction predicted for a step of length bounded by V(LMAX0). These 
summary lines are produced every IV(OUTLEV) iterations, and they are 118 
characters long (including the carriage control character). If [V(OUTLEV) < 0, 
then short summary lines are produced every —IV(OUTLEV) iterations; these 
lines are 79 characters long (55 if IV(COVPRT) = 0), and they include only the 
first six items listed above (i.e., IT, NF, F, RELDF, PRELDF, and RELDX). 


3.12 Changing Computers 


The NL2SOL distribution tape contains both single- and double-precision ver- 
sions of the NL2SOL source code, so it should be unnecessary to change preci- 
sions. (On computers having only 32 or 36 bits per REAL word, double precision 
often gives better performance.) 
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Only the functions IMDCON and RMDCON contain machine-dependent 
constants. To change from one computer to another, it should suffice to change 
the DATA statements in these functions. The DATA statement in IMDCON 
sets IMDCON(1) to the output unit number that DFAULT supplies to 
IV(PRUNIT). The machine-dependent DATA statement in RMDCON provides 
three values: BIG, ETA, and MACHEP. BIG is the largest floating-point number 
such that a FORTRAN program can compute SQRT(0.999*BIG)**2 (ie., 
DSQRT(0.999D0*BIG)**2 in double precision) without overflowing. Similarly, 
ETA is the smallest floating-point number such that SQRT(1.001*ETA)**2 (or 
DSQRT(1.001D0* ETA)**2, respectively) does not underflow. MACHEP is the 
unit roundoff, that is, the smallest floating-point number such that 1 + MACHEP 
yields a stored floating-point number greater than 1. (Some computers feature 
registers that carry more bits than can be stored; MACHEP should only reflect 
the accuracy of numbers that can be stored.) DATA statements giving suitable 
values for BIG, ETA, and MACHEP for a variety of computers appear as 
comments in RMDCON. 

Intrinsic functions are explicitly declared in the NL2SOL source code. On 
certain computers (e.g., Univac), it may be necessary to comment out these 
declarations. So that this may be done automatically by a simple program, such 
declarations are preceded by a comment having C/+ in columns 1-3 and blanks 
in columns 4-72 and are followed by a comment having C/ in columns 1 and 2 
and blanks in columns 3-72. 


3.13 Using Reverse Communication: NL2ITR 


Instead of writing subroutines CALCR and CALCJ to compute the residual 
vector R(X) and Jacobian matrix J(X), one can call NL2ITR and provide R and 
J by reverse communication. The calling sequence is 


CALL NL2ITR (D, IV, J, N, NN, P, R, V, X) 


Parameters IV, N, P, V, and X are the same as the corresponding ones to 
NL2SOL, with the following exceptions: V need only contain 93 + 2N + P(3P + 
31)/2 elements, since the storage that NL2SOL and NL2SNO allocate for D, J, 
and R at the end of V is not needed; and components IV(D), IV(J), and IV(R) 
are not referenced. D is the scale vector (dimensioned D(P)). NN is the (integer) 
lead dimension for the J array, which is dimensioned J(NN, P); NN must satisfy 
NN =N. 

When NL2ITR is first called (with IV(1) = 0 or 12), J must have been set to 
J(X), R to R(X). When NL2ITR wants R to be evaluated at a new X, it returns 
with IV(1) = 1; the caller should then set R to R(X) (unless X is out of range, in 
which case the caller should set IV(TOOBIG), that is, IV(2), to 1) and call 
NL2ITR again. Similarly, when NL2ITR wants J to be evaluated at X, it returns 
with IV(1) = 2, and the caller should then set J to J(X) and call NL2ITR again. 
(If J cannot be evaluated at X, the caller may set IV(NFGCAL), that is, IV(7), to 
0; this will cause NL2ITR to give the error return IV(1) = 15.) 


3.14 STOPX 


It is possible to arrange for NL2SOL (NL2SNO and NL2ITR) to be interrupted 
before each evaluation of R(X) when used in an interactive environment. To do 
this, it is necessary to replace the logical function STOPX supplied with the 
NL2SOL package (which always returns .FALSE.) by a system-dependent 
STOPX that returns . TRUE. if and only if the “break” (i.e., “interrupt’”’) key has 
been pressed since the last call on STOPX. Once this is done, NL2SOL will return 
with IV(1) = 11 when the “break” key is pressed before some other return has 
occurred. It is then possible to change some of the IV and V input components 
and restart; see Section 3.7. 
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3.15 Other V Input Values 

V(COSMIN) ... V(43) € [MACHEP, 1] is the minimum absolute cosine allowed 
between the step just taken, Ax, and the corresponding change in gradients, 
Ag, for a full update of the S matrix to be made. If | Ax"Ag| /(|| Ax|l2 - || Ag] 2) 
< V(COSMIN), then Ax'Ag is replaced in the update formula by sign 
(Ax™Ag)V(COSMIN) || Ax || 2 || Ag || 2. Default = max{10°°, 100 MACHEP}. 


V(DECFAC) ... V(22) € [0.01, 0.8] is the factor by which the trust region radius 
is shrunk if CALCR sets NF to 0 (or NL2ITR is called with IV(1) = 1 and 
IV(TOOBIG) = 1). Default = 0.5. 


V(EPSLON) ... V(19) € [0.001, 0.9] is the maximum relative difference allowed 
between g'Ax + 1/2Ax"HAx and its optimal value subject to the constraint 
|| diag(D)Ax ||2 = V(RADIUS), where Ax is the step being computed, g is the 
current gradient, and H is the current Hessian approximation. This is used in 
detecting and handling the special case discussed in [2]. Default = 0.1. 


V(FUZZ) ...V(45) € [1.01, 100] is used in the test that decides whether to switch 
models. If g is the current model for F (near the point X) and g is the other 
model, and if 


V(FUZZ) | q(X + Ax) — F(X + Ax) |<] q(X + Ax) — F(X + Ax) |, 
then the models are switched. Default = 1.5. 


V(INCFAC) ... V(23) € [1.2, 100] is the minimum factor by which the trust 
region radius is increased (when it is increased at all). Default = 2. 


V(PHMNFC) ... V(20) € [—0.99, —0.001] is the minimum value allowed for 
[ || diag(D) Ax || 2 — VO(RADIUS)]/V(RADIUS). Default = —0.1. 


V(PHMXFC) ... V(21) € [1.2, 100] is the maximum value allowed for 
[ || diag(D)Ax || 2 — VORADIUS)]/V(RADIUS). Default = 0.1. 


V(RDFCMN) ... V(24) € [0.01, 0.8] is the minimum factor by which the trust 
region radius, V(RADIUS), may be shrunk. Default = 0.1. 


V(RDFCMX) ... V(25) € [1.2, 100] is the maximum factor by which the trust 
region radius, V(RADIUS), may be increased at one time. Default = 4.0. 


V(RLIMIT) .. . V(42) = 10"° is the largest value allowed for || R(X) || 2 before F(X) 
is considered to overflow. Default = (0.999. BIG)'”7, where BIG is described in 
Section 3.12. 


V(TUNER2) ... V(27) € [0, 0.5]. For a step to be accepted, the actual function 
reduction must be more than V(TUNER2) times its predicted value. Default 
= 0.0001. 


V(TUNERS) ... V(28) € [0.001, 1]. If the actual function decrease is at least 
V(TUNER3) times the inner product of the step and the gradient (at the start 
of the step), then the trust region radius is increased. Default = 0.75. 


V(TUNER4) ... V(29) € [—1, 1]. If the disposition of the new radius has not yet 
been decided and either 


|| diag(D)“'[HAx — (g — g0)]||< V(TUNER4) || diag(D)~'g || 


or g' Ax < V(TUNERS) g} Ax, where Ax is the step just taken, H is the Hessian 
approximation used in computing Ax, go is the old gradient, g is the new 
gradient, and D is the newly updated scale vector, then the radius is increased 
by a factor of V(IINCFAC). Otherwise, it is left unchanged. Default = 0.5. 


V(TUNERS) ... V(30) = MACHEP is described above with V(TUNER4). 
Default = 0.75. 
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3.16 Storage Requirements 


NL2SOL, NL2SNO, and the subroutines from the NL2SOL package that they 
call amount to around 2360 FORTRAN statements (including nonexecutable 
statements, such as type statements, but excluding comments); the many com- 
ments bring the source code up to nearly 5200 lines. When compiled by the H- 
extended compiler on the IBM 370/168 at the Massachusetts Institute of Tech- 
nology, this source code results in about 56,300 bytes of object code. The amount 
of variable storage used is listed above in Section 3.1. 
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ALGORITHM 574 
Shape-Preserving Osculatory Quadratic 
Splines [E1, E2] 


D. F. McALLISTER 

North Carolina State University 
and 

J. A. ROULIER 

University of Connecticut 


Key Words and Phrases: polynomial interpolation, osculation, shape preserving, convexity 
preserving, monotonicity preserving, Bernstein polynomial 

CR Categories: 5.18, 8.2 

Language: FORTRAN 


DESCRIPTION 


This algorithm is a FORTRAN implementation for the procedure developed in 
[3]. Let n data points {(x:, y:)}%1 and n first derivatives {m;}%1 at these data 
points be given, with x; = xi41, 1 isn -— 1. The algorithm constructs a smooth 
osculatory quadratic spline S, which satisfies 


(1) S(xi) =y, 1Sisn; 

(2) S'(x;) =m, 1Sit<sn; 

(3) S preserves monotonicity and convexity in the case that the slopes m; are 
consistent with the shape of the data; 

(4) the knots of the spline S include the data points and at most two additional 
knots between adjacent data points. 


The spline S is a piecewise quadratic Bernstein polynomial with a continuous 
first derivative. 


Subroutine SLOPES 


This subroutine will calculate values for the slopes {7;}i=1, which will always be 
consistent with the shape of the data and which guarantee that at most one 
additional knot is required between adjacent, data points. This subroutine is 
called before the main routine MEVAL if the user does not wish to provide these 
values. 
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Subroutine MEVAL 


The input to MEVAL is the set of data points {(x;, yi)} 7-1, the slopes {m;}i-1, 
and a vector of abscissas u = (U1, ..., Um) at which the spline S is to be evaluated. 
In addition, a nonnegative tolerance parameter EPS must be specified for use by 
the subroutine CHOOSE to distinguish various cases which the algorithm must 
consider. This parameter is described later. If an argument u; is determined by 
the subroutine SEARCH to lie in the interval [x;, x.+1], then MEVAL calls the 
subroutines CHOOSE and CASES, in that order, to compute the parameters of 
S for the interval. The subroutine then calls a function subprogram SPLINE 
which evaluates S at the argument u;. Extrapolation is performed for those 
components of u that lie outside the interval [xi, x, ]. 

On exit from MEVAL the error parameter ERR is zero if processing proceeded 
normally and no extrapolation was required. ERR is 1 if at least one component 
of the vector u lies outside the interval [x;, x, ]. A value of 2 indicates that the 
components of the vector u were not in ascending order, in which case no values 
of S are returned. 


Subroutine SEARCH 


This subroutine is a binary search used by MEVAL to locate the interval in 
which an argument of S lies. 


Subroutine CHOOSE 


The value of S on an interval [x:, x:+:] depends only on the points (x:, yi) and 
(xi+1, Yit1) and the slopes m; and mi+; at these points. The subroutine determines 
which of Cases 1-4 applies [3]. The tolerance parameter EPS is used by CHOOSE 
to handle the pathologies that may occur. When the user provides values for the 
slopes other than those computed by the subroutine SLOPES, small perturbations 
may cause unwanted changes in the shape of the resulting spline. If the values of 
m; or mi+: are relatively close to either the slope S; of the line joining the points 
(xi, yi) and (xi+1, ¥i+1) Or to 2S;, roundoff may affect both the monotonicity and 
convexity of the spline. For example, if | M — S;| = EPS|S;| for M = m; or mis, 
then the algorithm assumes that M = S; and chooses either Case 2 or Case 3. We 
avoid Case 1 to preclude a nearly linear spline joining the two data points. 
Similarly, in order to avoid a spline with sharp bends at the endpoints, if | m:| > 
2|S;| and | mis:| > (2 — EPS)|S;|, then the algorithm assumes | mi+:| > 2| Si | 
and selects Case 4 rather than Case 3. These choices are for aesthetics only and 
can easily be overridden by modifying the slopes m; and mj+1 and/or setting EPS 
to a smaller value. If EPS # 0, then EPS should be greater than or equal to 
machine epsilon. 


Subroutine CASES 

After CHOOSE determines the correct case number, the subroutine CASES 
calculates the knots and other parameters which define S on the interval 
[x:, xi+1]. The spline S will have a single knot between x; and xi+: if NCASE is 1, 
2, or 3. Case 4 requires two knots. 


Function Subprogram SPLINE 

Given the case number determined by CHOOSE and the parameters calculated 
by CASES, SPLINE determines the location of the argument relative to the 
knots in the interval and computes S(u;), which is the value of a quadratic 
Bernstein polynomial. 
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ALGORITHM 575 
Permutations for a Zero-Free Diagonal [F1] 


1.S. Duff 
AERE Harwell, England 


Key Words and Phrases: unsymmetric permutations, maximum transversal, maximum assignment, 
block triangular form, sparse matrices 

CR Categories: 5.0, 5.1, 5.3, 5.4 

Language: FORTRAN 


DESCRIPTION 
The subroutine is evoked by the FORTRAN statement 
CALL MC21A(N, ICN, LICN, IP, LENR, IPERM, NUMNZ, IW) 


where the parameters are described in the listing given here. 

Given the pattern of nonzeros of a sparse matrix, this subroutine attempts to 
find a row permutation that makes the matrix have no zeros on its diagonal. It is 
possible that the user may input a matrix for which there is no permutation that 
makes the diagonal zero-free. An example of this is 


(x 0) 


In such instances the algorithm will produce a permutation that will put as many 
nonzeros on the diagonal as possible (1 in the above example). This number will 
be output in NUMNZ. The array IPERM will still hold a permutation of the 
integers 1, 2,..., N, but in this case N-NUMNZ of the elements (IPERM(I), I) 
will be zero. 

It is envisaged that a common use of the subroutine will be as the first part of 
a two-stage process for the determination of the block triangular form of a sparse 
matrix (see, for example, [1]). The second stage could be performed by Harwell 
subroutine MC13D [4], and the two stages are combined by using subroutine 
MC23A in the Harwell package MA28 [2]. 

The subroutine is based on a depth first search with look-ahead technique and 
is described in detail in [3]. There, numerical results from using this subroutine, 
which has been tested on a wide range of both structured and randomly generated 
matrices, are also discussed. 

This subroutine has been written in American National Standard FORTRAN. 
Special comment cards have been included so that Harwell subroutine OK04A 
can be used to make an IBM FORTRAN version that uses half-length integers 
(INTEGER®*2) for all the arrays except IP. This approximately halves the core 
requirements at the cost of restricting the order of the system to 2° — 1. 
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ALGORITHM 


{A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service. | 


S 1S THE STANDARD FORTRAN VERSION SI/ 
I IS THE IBM VERSION 


Aaa 


SUBROUTINE MC@1A(N, ICN, LICN, IP. LENR, IPERM, NUMNZ, IW) 


DESCRIPTION OF PARAMETERS. 
INPUT VARTABLES N, ICN, LICN, IP, LENR. 
OUTPUT VARIABLES IPERM, NUMNZ. 


N ORDER OF MATRIX. 

ICN ARRAY CONTAINING THE COLUMN INDICES OF THE NON-ZEROS. THOSE 
BELONGING TOG A SINGLE ROW MUST BE CONTIGUOUS BUT THE ORDERING 
OF COLUMN INDICES WITHIN EACH ROW IS UNIMPORTANT AND WASTED 
SPACE BETWEEN ROWS IS PERMITTED. 

LICN LENGTH GF ARRAY ICN. 

IP IPCI), T=i,2,...M, IS THE POSITION IN ARRAY ICN OF THE FIRST 
COLUMN INDEX OF A NON-ZERO IN ROW I. 

LENR LCENR(I) IS THE NUMBER OF NON-ZEROS IN ROW I, I=1,2...N. 

IPERM CONTAINS PERMUTATION TQ MAKE DIAGONAL HAVE THE SMALLEST 
NUMBER OF ZEROS ON IT. ELEMENTS (CIPERM(1I),1I) I=1, ... N ARE 
NON-ZERO AT THE END OF THE ALGORITHM UNLESS MATRIX 
IS STRUCTURALLY SINGULAR. IN THIS CASE, (IPERM(T), I) WILL 
BE ZERO FOR N-NUMNZ ENTRIES. 

NUMNZ NUMBER GF NOQN-ZEROS ON DIAGONAL OF PERMUTED MATRIX 

IW WORK ARRAY .. SEE LATER COMMENTS. 


DQADGAAAANAANANANAANANANADAAANA 


INTEGER IP(N) 

INTEGER#2 ICN(LICN), LENR(N), IPERM(N), IWCN, 4) I/ 

INTEGER ICN(LICN), LENR(N). IPERM(N), IWCN, 4) 

CALL MC@1B(N, ICN, LICN, IP, LENR. IPERM, NUMNZ, IW(1, 1), 
# IWCi,2), IWCi,3), IWC1,4)) 


~ 
Ra 


RETURN 
END 
C/ 
SUBROUTINE MC21B(N, ICN, LICN, IP, LENR, IPERM, NUMNZ, PR, ARF, 
# CV, QUT) 
INTEGER IP(N) 
C 
C DIVISION OF WORK ARRAY IS NOW DESCRIBED. 
Cc 
C PR(I) IS THE PREVIOUS ROW TO I IN THE DEPTH FIRST SEARCH. 
C ARP(I) IS ONE LESS THAN THE NUMBER OF NON-ZEROS IN ROW I 
C WHICH HAVE NOT BEEN SCANNED WHEN LOOKING FOR A CHEAP ASSIGNMENT. 
C CVI) IS THE MOST RECENT ROW EXTENSION AT WHICH COLUMN I 
C WAS VISITED. 
C OUT(I) IS ONE LESS THAN THE NUMBER OF NON-ZEROS IN ROW I 
Cc WHICH HAVE NOT BEEN SCANNED DURING ONE PASS THROUGH THE 
C MAIN LOOP. 
C 
Cc INTEGER#2 ICN(LICN), LENR(N), IPERM(N),PR(N), CV(N), iv 
C TARP(N),OUT(N) I/ 
INTEGER ICN(LICN), LENR(N), IPERM(N), PR(N), CV(N), ARP(N), OUTCN) 
C 
Cc INITIALIZATION OF ARRAYS. 
DO 10 I=1.N 
ARP(T) = LENR(I) - 1 
CV(I) = 0 
TPERM( 1) = 0 


10 CONTINUE 
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AIA AG 


to) 


AG 


OAD 


NUMNZ = O 


MAIN LOOP. 


EACH PASS ROUND THIS LOOP EITHER RESULTS IN A NEW ASSIGNMENT 


OR GIVES A ROW WITH NO ASSIGNMENT. 
DO 100 JORD=1,N 
J = JORD 
PR(J) = ~1 
DO 70 K=1, JORD 
LOOK FOR A CHEAP ASSIGNMENT 
INL = ARP(J) 
IF (INL. LT.O) GO TO 30 
IN2 = IP(J) + LENR(J) - 1 
INL = IN2@ ~- INI 
DO 20 IT=INI, IN2 
I = ICNC(TI) 


IF (IPERM(I).EQ@.0) GO TO 80 


20 CONTINUE 
NO CHEAP ASSIGNMENT IN ROW. 
ARP(J) = --1 


BEGIN LOOKING FOR ASSIGNMENT CHAIN STARTING WITH ROW J. 


30 OUT(J) = LENR(J) ~- 1 


INNER LOOP. EXTENDS CHAIN BY ONE OR BACKTRACKS. 


DO 60 KK=1, JORD 
IN1 = QOUT(U) 
IF CINI. LT. 0) GO TO SO 
IN2 = IP(J) + LENR(J) - 1 
IN1 = IN@ - INI 

FORWARD SCAN. 
DO 40 II=IN1, IN2 
I= JTCN(CEI) 


IF (CVCTI). EG. JORD) GO TQ 40 
COLUMN I HAS NOT YET BEEN ACCESSED DURING THIS PASS. 


Jl = J 
Jo= JTPERM(I) 
CVCI) = JORD 


PR(J) = JI 
OUT(J1) = IN@ - 11 - 1 
60 TO 70 
40 CONTINUE 
BACKTRACKING STEP. 
90 Jo= PROJ) 
IF (J. E@ -1) GO TO 100 
40 CONTINUE 


70 CONT INVE 


NEW ASSIGNMENT IS MADE. 
80 IPERM(I) = J 
ARP(Y) = IN2@ - II - J 
NUMNZ = NUMNZ + | 
DO 90 K=1, JORD 
J = PRCY) 
IF (J. EQ@.--1) GO TO 100 
IT = IP(J) + LENR(J) ~ OUT CU) 
I = ICNCII) 
TIPERM(I) = J 
70 CONT INVE 


100 CONTINUE 


IF MATRIX IS STRUCTURALLY SINGULAR, 
PERMUTATION IPERM 
IF (NUMNZ.EQ.N) GO TO 150 
DO 110 T=1,N 
ARP(T) = QO 
110 CONTINUE 
K = 0 
DO 130 [=1,N 
IF (IPERM(I).NE.O) GO TO 120 
K = K + 1 
QOUTCK) = I 
60 TO 130 
120 J = IPERM(CT) 


- 2 


WE NOW COMPLETE THE 


575-P 3- 
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ARP(J) = 1 
190 CONTINUE 
K = 9 
DO 140 J=1,N 
IF (ARP(I).NE.O) GQ TO 140 
K=K + 1 
IQUTK = OQUT(K) 
IPERM(IOUTK) = I 
140 CONTINUE 
150 RETURN 
END 
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ALGORITHM 576 
A FORTRAN Program for Solving Ax = b 
[F4] 


|. BARRODALE 
University of Victoria 
and 

G. F. STUART 
Camosun College 


Key Words and Phrases: linear equations, Gaussian elimination, new pivoting strategy 
CR Categories: 5.13, 5.14 
Language: FORTRAN 


DESCRIPTION 
Given any n X n system of linear equations 
Ax=b (1) 


and a number e, the algorithm calculates the solution x to (1), if e <= 0, or an 
approximation solution x satisfying 


|b — Ax |... <«, (2) 


if ¢ > 0. Furthermore, if A appears to be singular, an approximate solution to (1) 
is still determined, although it does not satisfy (2). 

The algorithm consists of Gaussian elimination combined with a new pivoting 
strategy based on the following fact. Suppose after the kth step (k = 0,1,..., 
n — 1) of Gaussian elimination that x” = [x{”, ..., x, 0, ..., OJ" is the 
approximate solution obtained by back substitution in the first k equations. Then 
the right-hand sides of the last n — k equations are the nonzero components of 
the residual vector r® = b — Ax™ this is proved in [1]. Our pivoting strategy 
thus chooses the equation with the absolutely largest residual as the next equation 
to be eliminated, and the (& + 1)th pivot is then selected as the absolutely largest 
of the n — k coefficients on the left-hand side of the chosen equation. Finally, the 
pivot is positioned on the principal diagonal by, if necessary, a row interchange 
and a column interchange. 

When e€ > 0, the algorithm terminates after k Gaussian elimination steps and 
yields x“ by back substitution in the first k equations. Normally, x” has k 
nonzero components and it satisfies k of the eqs. (1) exactly (ignoring rounding 
errors). However, if € is a small positive number, in order to satisfy (2) it may be 
necessary to determine the solution x rather than x™: in such a case, k has the 
value n on output. 
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The elimination is performed by subroutine MODGE, which terminates after 
stage k if there is not a suitably large residual among the remaining (7 — 2) right- 
hand sides, or if the coefficient matrix of the remaining (n — k) rows is considered 
to be singular. The first condition is detected by comparing all residuals with the 
real input parameter EPS. Hence EPS should be set to a small positive value 
representing an insignificant residual for cases in which premature termination is 
sought; otherwise EPS should be set less than or equal to zero. The second 
premature termination condition is controlled by the real input parameter 
TOLER. The equation with the absolutely largest residual is rejected as the pivot 
row if the absolute value of the pivot is not greater than TOLER. In this case 
complete pivoting is performed during the (k + 1)th stage. However, if this 
produces no pivot greater in absolute value than TOLER, the elimination is 
terminated and an approximate solution is determined by back substitution in 
the first & equations. 

The algorithm can thus be applied to any n X n system of linear equations, 
although it is particularly well suited to problems where the residuals (right- 
hand sides) can be made small by solving for fewer than n of the unknowns. 
Interpolation problems are often of this type, since some of the parameters x; 
frequently turn out to be quite small in practice. Also, ill-conditioned (and even 
singular) systems of equations can often be handled satisfactorily by choosing 
appropriate values for EPS and TOLER (see Examples 3 and 4). 

The accuracy of a computed solution to Ax = b can usually be increased by 
iterative improvement, and subroutine REFINE is supplied for this purpose. A 
feature of this subroutine is that the (¢ + 1)th residual vector r;+4; is computed as 


Yreu1 = Yi — Ax, t= 0, 1, 2, wate (3) 


where the residual r; and the computed solution x; are taken from the previous 
iteration, and ro = b. (It has been our experience that (3) permits better control 
of convergence than the more usual computation r;4; = b — A(xo + x1 + +--+ + 
x,).) In this subroutine the output parameter DIGITS is used to estimate (usually 
fairly conservatively) the number of significant digits in the initial solution Xo. 
Basically, this is determined as logioD, where D = min; | Xo;/x1, |, excluding values 
of z for which xo, = 0 or x1; = 0. However, if the quantity logioD is greater than 
logio(1/E), where E = max(ERR, 10%) and d represents the number of deci- 
mal digits of accuracy available on the computer, then DIGITS is set equal to 
logio(1/E) rather than logioD. 

The following four examples were solved on an IBM 370/148 using a WATFIV 
compiler. All of the computations were performed in single-precision arithmetic 
(about 7 decimal digits) apart from the calculation of the residuals (3), which 
were formed in double-precision arithmetic and then assigned to a single-precision 
vector. 

Example 1. Determine parameters xi, x2, and x3 such that the quadratic 
polynomial x; + x2t + xst? interpolates the data {(1, 89), (4, 209), (5, 201)}. 
Equivalently, solve the 3 x 3 system of linear equations 


1 1 Ltt x 89 
1 4 16]]| x2] =] 209 |. 
1 5 254L%3 201 


This example is used in [1] to illustrate our algorithm: the exact solution is x, = 
1, x2 = 100, and x3 = —12. 

Setting EPS = 0 and TOLER = 10~°, subroutine MODGE gives x; = 1.000010, 
x2 = 99.99998, and x3 = —11.99999. 

Setting EPS = 1 and TOLER = 10~, subroutine MODGE terminates after two 
Gaussian elimination steps and gives x = 0, x2 = 100.4500, and x3 = —12.04999. 


Example 2. Determine x, x2, ..., X5 such that the function x1f + xet? + xst? 
+ x4t* + xst° interpolates te~ for t = 0.25(0.25)1.25. Equivalently, solve Ax = b 
where 
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0.25 0.257 .-- 0.25° 0.25e °° 
0.50 0.507 --- 0.505 0.50e~°° 
A =| 0.75 0.75% --- 0.75°| and b=]0.75e°” 
1.00 1.00? --- 1.00° 1.00e71 
1.25 1.25% «+. 1.95% 1.25e 715 


Generating the elements of A and b within the computer (rather than reading 
them in as data), and setting EPS = 0 and TOLER = 107°, subroutine MODGE 
gives x; = 0.9994718, x2 = —0.9950786, x3 = 0.4832436, x4 = —0.1396533, and x5 = 
0.01989542. (This solution contains almost one extra significant digit than the 
solution that can be obtained from Gaussian elimination with partial pivoting, 
using the modified version [3] of the subroutines in [2].) Iterative improvement 
is then applied to this initial solution. 

Setting ERR = 107’ and ITER = 14, subroutine REFINE converges after two 
iterations to x, = 0.9994708, x2 = —0.99507038, x3 = 0.4832247, x, = —0.1396357, 
and x; = 0.01988983. The output parameter DIGITS indicates that the initial 
solution contains approximately 3.6 significant digits. 


Example 3. Determine x1, x2, ..., x9 such that the function x, + xet + 
x(t — 1) + xqt? + x5(t? — t) + xet* + x(t? — t?) + xet* + x9(t* — t*) interpolates 
e’ for t = 0(0.125)1. 

Setting EPS = TOLER = 10~°, subroutine MODGE gives x; = 0.9999993, x2 
= 0.9994056, x3 = 0, x4 = 0.5071687, x5 = x6 = x7 = 0, xs = 0.2117074, and x9 = 
—0.1439046. The output parameters OCODE and PIVOT have the values 3 and 
2, respectively, indicating that the computation was terminated prematurely 
because a pivot was chosen (by complete pivoting) whose magnitude is less than 
TOLER. 

Setting ERR = 10-’ and ITER = 14, subroutine REFINE converges after two 
iterations to x, = 1.000000, x2 = 0.9994109, x, = 0.5071452, xs = 0.2117255, and xo 
= —0.1439375. DIGITS has the value 3.6 on output. 


Example 4. Determine x, x2, ..., X32 such that the function 
15 
P(s, t) = x1 + Y (x2; Re(z’) + x2j+1 Im(z’)) + x32 Re(z”), 
j=l 
where z = s + it, interpolates Q(s, t) = e® ***” on the 32 points (s, t) for which 
s = 0(0.125)1, ¢ = 0(0.125)1. This problem arises when attempting to solve 
approximately the Dirichlet problem for Laplace’s equation on a unit square with 
boundary value Q. The coefficients x; of the harmonic polynomial P are deter- 
mined by collocation, that is, by requiring that P = Q on the 32 specified boundary 
points. (We arranged the resulting 32 linear equations in order by proceeding in 
an anticlockwise direction around the boundary of the square, starting from the 
origin.) 

Setting EPS = 0 and TOLER = 10°, subroutine MODGE gives an initial 
solution containing no significant digits: many of the 32 computed coefficients x; 
have exponents of size 10° or 10* and only eight coefficients have magnitudes less 
than 20. (The initial solution that can be obtained from Gaussian elimination 
with partial pivoting also contains no significant digits.) Setting ERR = 107’ and 
ITER = 14, subroutine REFINE diverges, that is, all 14 iterations are performed 
without improvement in the accuracy of the coefficients x;. The output parameter 
DIGITS has a negative value, clearly indicating that the initial solution contains 
no significant digits. (ae 

However, setting EPS = 0.05 and TOLER = 10°, subroutine MODGE termi- 
nates after 22 Gaussian elimination steps and gives an initial approximate solution 
in which 10 coefficients are set to zero and the remaining 22 coefficients vary 
from a minimum of x27 = —9.698888 to a maximum of x29 = 12.78670. Setting 
ERR = 10°’ and ITER = 14, subroutine REFINE converges after three iterations: 
in this final solution x27 = —9.699727 and x29 = 12.78701. The output parameter 
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DIGITS indicates that the initial approximate solution contains approximately 
2.9 significant digits. 

This example illustrates how our algorithm can be used to produce a meaningful 
approximate solution to a system of linear equations whose numerical solution 
may be difficult to determine. The harmonic polynomial P*, say, given by the 
above approximate solution satisfies ||Q — P*||. <= 0.05 on the 32 specified 
boundary bounds, and a fine grid search establishes that ||Q — P* ||. = 0.06 on 
the complete boundary. By the maximum principle, it follows that the latter 
inequality also applies on the whole square. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service.] 


SUBROUTINE MODGE(N, NDIM. A. B, EPS, TOLER, P, @, Z, 

® X, K, OCODE, OPIVOT) 
THIS SUBROUTINE SOLVES ANY N~-BY-N SYSTEM OF LINEAR 
EQUATIONS AX=B, USING A MODIFICATION OF GAUSSIAN 
ELIMINATION. THE MODIFICATION OCCURS IN THE CHOICE OF 
PIVOTS: AT EACH STAGE THE PIVOT ROW IS DETERMINED BY THE 
ABSOLUTELY LARGEST RESIDUAL (RIGHT HAND SIDE), AND THEN 
THE PIVOT IS CHOSEN AS THE ABSOLUTELY LARGEST COEFFICIENT 
IN THE PIVOT ROW. THE PIVOT IS POSITIONED ON THE PRINCIPAL 
DIAGONAL BY (IF NECESSARY) A ROW INTERCHANGE AND A COLUMN 
INTERCHANGE. 


IF AFTER THE K-TH STAGE THE LARGEST RESIDUAL IS TOO SMALL 
(.LT. EPS), THE ELIMINATION IS TERMINATED. BACK 
SUBSTITUTION IS THEN USED TO OBTAIN AN APPROXIMATE 
SOLUTION WHICH SATISFIES THE FIRST K EQUATIONS. 


IF THE (K+1)-TH PIVOT IS TOO SMALL (. LE. TOLER), THE 
ELIMINATION IS TERMINATED. BACK SUBSTITUTION IS THEN USED 
TO OBTAIN AN APPROXIMATE SOLUTION WHICH SATISFIES THE 
FIRST K EQUATIONS. 


DESCRIPTION OF PARAMETERS: 


N AN INTEGER DENOTING THE NUMBER OF EQUATIONS 
(N. GE. 1). 

NDIM AN INTEGER PARAMETER FOR ADJUSTABLE DIMENSIONS 
(NDIM. GE. N). 

A A REAL ARRAY OF NDIM ROWS AND AT LEAST N 


COLUMNS WHICH ON ENTRY MUST CONTAIN THE COEFFICIENT 
MATRIX A IN ITS FIRST N ROWS AND N COLUMNS. 
ON EXIT THE FIRST K ROWS AND K COLUMNS (K.LE.N) OF 
& CONTAIN THE LU DECOMPOSITION OF YHE K EQUATIONS 
SATISFIED. 

B A REAL ARRAY OF DIMENSION AT LEAST N WHICH 


AANAIAANAANAINAANANANAAAANANANAANANANADANAAHGSA 


COLLECTED ALGORITHMS (cont.) 


ONQAGSINOAAADAANAANNAANAAANAAIANAAADAAANDNNADANNAANAAKADnnnnannnananannnnnnnnnnnnnanan 


AOannianwann 


ON ENTRY MUST CONTAIN IN POSITIONS 1 TO N THE RIGHT 
HAND SIDE VECTOR B. 
ON EXIT THE POSITIONS K+1 TO N CONTAIN THE RESIDUALS 
OF THE UNSATISFIED EQUATIONS. 

EPS A REAL INPUT TOLERANCE. IF THE (ABSOLUTELY) LARGEST 
RESIDUAL AT ANY STAGE OF THE ELIMINATION IS LESS 
THAN EPS THEN THE ELIMINATION IS TERMINATED AND 
BACK SUBSTITUTION COMMENCES. PREMATURE TERMINATION 
OF THIS TYPE CAN BE AVOIDED BY SETTING EPS TO ZERO. 

TOLER A REAL POSITIVE INPUT TOLERANCE. IF THE ABSOLUTE 
VALUE OF THE PIVOT AT ANY STAGE OF THE ELIMINATION 
IS LESS THAN OR EQUAL TO TOLER, THEN COMPLETE 
PIVOTING IS USED FOR THIS STAGE. IF THE ABSOLUTE 
VALUE OF THE NEW PIVOT IS LESS THAN OR EQUAL TO 
TOLER, THE REMAINING EQUATIONS ARE CONSIDERED 
TO BE LINEARLY DEPENDENT, AND SO THE ELIMINATION 
IS TERMINATED AND BACK SUBSTITUTION COMMENCES. 
TOLER SHOULD NORMALLY BE SET TO APPROXIMATELY 
LO##(-D+1), WHERE D REPRESENTS THE NUMBER OF 
DECIMAL DIGITS OF ACCURACY AVAILABLE. HOWEVER, 
PROBLEMS WHICH ARE NOT ’REASONABLY SCALED’ 
BEFOREHAND COULD REQUIRE A MUCH LARGER OR 
SMALLER VALUE FOR TOLER THAN IS RECOMMENDED 
HERE. 

P AN INTEGER ARRAY OF DIMENSION AT LEAST N USED TO 
RECORD COLUMN INTERCHANGES OF THE ARRAY A. 
ON EXIT P(I) IS THE INDEX OF THE ORIGINAL POSITION 
OF COLUMN IT. 

Q AN INTEGER ARRAY OF DIMENSION AT LEAST N USED TO 
RECORD ROW INTERCHANGES OF THE ARRAYS A AND B. 
ON EXIT Q(I) IS THE INDEX OF THE ORIGINAL POSITION 


OF ROW I. 
Z A REAL WORK SPACE ARRAY OF DIMENSION AT LEAST N. 
X & REAL GUTPUT ARRAY OF DIMENSION AT LEAST N 


WHICH CONTAINS THE SOLUTION (CIN CORRECT ORDER) OF 
THE N LINEAR EQUATIONS IN POSITIONS 1 TON. 
IF THE SOLUTION IS OBTAINED USING LESS THAN N 
EQUATIONS, THEN THE REMAINING COMPONENTS OF X ARE 
SET TO ZERO. 
K AN INTEGER WHICH ON OUTPUT DENOTES THE NUMBER OF 
EQUATIONS SATISFIED (K.LE.N). 
OCODE AN INTEGER EXIT CODE WITH VALUES: 
O- EITHER N.LE.O OR (N. EQ. 1 AND AC1,1).EQ.0). 
1- THE SYSTEM AX=B IS SOLVED. 
2- THE ELIMINATION IS TERMINATED BY USE OF 
EPS (SMALL RESIDUAL). 
3- THE ELIMINATION IS TERMINATED BY USE OF 
TOLER (SMALL PIVOT). 
OPIVOT AN INTEGER EXIT CODE WITH VALUES: 
1- COMPLETE PIVOTING IS NOT EMPLOYED. 
2- COMPLETE PIVOTING IS EMPLOYED, HENCE SMALL 
RESIDUALS (.LT. EPS) MAY HAVE BEEN ALLOWED. 


AN IMPLEMENTATION NOTE: 
IF YOUR FORTRAN COMPILER PERMITS A SINGLE COLUMN OF A TWO 
DIMENSIONAL ARRAY TO BE PASSED TO A ONE DIMENSIONAL ARRAY 
THROUGH A SUBROUTINE CALL, CONSIDERABLE SAVINGS IN 
EXECUTION TIME MAY BE ACHIEVED BY USING SUBROUTINE 
SAXPY (SEE A.C.M.. TRANSACTIONS ON MATHEMATICAL 
SAFTWARE VOL. 5 NUM. 3 1979 PP. 308-323) 

SUBROUTINE REFINE(N, NDIM, A, B, ALU, P, Qs KMAX, 

# ERR, R,» GS, XNEW, DX, X, ITER, DIGITS) 
THIS SUBROUTINE PERFORMS ITERATIVE IMPROVEMENT ON THE 
COMPUTED SOLUTION X OBTAINED FROM SUBROUTINE MODGE. 
THE ITERATIONS CONTINUE UNTIL EITHER THE CORRECTIONS 
TO X ARE NEGLIGIBLE, I.E. CONVERGENCE OCCURS (SEE 
DESCRIPTION OF ERR), OR UNTIL COMPLETION OF THE 
MAXIMUM NUMBER OF ITERATIONS ALLOWED CITER). 


THE FOLLOWING TABLE GIVES THE CORRESPONDENCE BETWEEN THE 
OUTPUT PARAMETERS OF MODGE AND THE INPUT PARAMETERS OF 
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REFINE: 


NAME ON OUTPUT FROM MODGE: NAME ON INPUT TO REFINE: 


N N 
NDIM NDIM 
A ALU 
P P 

re) Qa 

K KMAX 
% X 


DESCRIPTION OF PARAMETERS: 


N 


NDIM 


A 


ALU 


XNEW 


ITER 


DIGITS 


AN INTEGER DENOTING THE NUMBER OF EQUATIONS 

(N. GE. 1). 

AN INTEGER PARAMETER FOR ADJUSTABLE DIMENSIONS 
(NDIM. GE. N). 

A REAL ARRAY OF NDIM ROWS AND AT LEAST N COLUMNS 
WHICH ON ENTRY MUST CONTAIN THE COEFFICIENT 
MATRIX A IN ITS FIRST N ROWS AND N COLUMNS. 

A IS NOT ALTERED BY REFINE. 

A REAL ARRAY OF DIMENSTON AT LEAST N WHICH ON 
ENTRY MUST CONTAIN IN POSITIONS 1t TO N THE RIGHT 
HAND SIDE VECTOR B. B IS NOT ALTERED BY REFINE. 
THE REAL OUTPUY ARRAY A OF SUBROUTINE MODGE. ALU IS 
NOT ALTERED BY REFINE. 

AN INTEGER ARRAY OF DIMENSION AT LEAST N. USED 

TO RECORD COLUMN INTERCHANGES OF THE ARRAY A. 

P IS THE GUTPUT ARRAY P OF SUBROUTINE MODGE. 

AN INTEGER ARRAY OF DIMENSION AT LEAST N. USED 

TO RECORD ROW INTERCHANGES OF THE. ARRAYS A AND B. 
Q IS THE OUTPUT ARRAY @ OF SUBROUTINE MODGE. 

THE INTEGER OUTPUT PARAMETER K OF MODGE. 

& REAL INPUT PARAMETER USED TO TEST FOR 
CONVERGENCE. ERR SHOULD NOT BE LESS THAN 1O##(-D), 
WHERE D REPRESENTS THE NUMBER OF DECIMAL DIGITS 
OF ACCURACY AVAILABLE. 

THE CONVERGENCE CRITERION IS: 

EXIT IF THE FOLLOWING RELATIONSHIP IS TRUE FOR 
ALL I=1 TO KMAX: 
ABS(DX(1I)). LE. ABSCERR#X(1I)). OR. X(I).EQ.0.0. 

A REAL WORK SPACE ARRAY OF DIMENSION AT LEAST N. 
(USED BY REFINE TO CALCULATE THE RESIDUALS AT EACH 
ITERATION. ) 

A REAL WORK SPACE ARRAY OF DIMENSION AT LEAST N. 
(USED BY REFINE TO CALCULATE THE CORRECTIONS, Dx, 
AT EACH ITERATION. ) 

A REAL WORK SPACE ARRAY QF THE SAME DIMENSION AS X. 
A REAL WORK SPACE ARRAY OF DIMENSION AT LEAST N. 
(USED BY REFINE TO CALCULATE A CORRECTION TO X 

AT EACH ITERATION. ) 

THE REAL OUTPUT ARRAY X GF SUBROUTINE MODGE. 

ON EXIT X CONTAINS (USUALLY) A BETTER SOLUTION 

TO THE LINEAR SYSTEM AX=B. 

AN INTEGER DENOTING, ON INPUT. THE MAXIMUM NUMBER 
OF ITERATIONS OF ITERATIVE IMPROVEMENT ALLOWED. 
ITER SHOULD NOT EXCEED 2#D, WHERE D REPRESENTS 
THE NUMBER OF DECIMAL DIGITS OF ACCURACY AVAILABLE. 
ON OUTPUT ITER IS THE ACTUAL NUMBER OF ITERATIONS 
COMPLETED. 

A REAL PARAMETER WHICH ON OUTPUT INDICATES THE 
APPROXIMATE NUMBER OF SIGNIFICANT DIGITS IN THE 
INITIAL SOLUTION (I.E. THE SOLUTION FROM 

MODGE >). 
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ALGORITHM 577 
Algorithms for Incomplete Elliptic Integrals 
[S21] 


B. C. CARLSON and ELAINE M. NOTIS 
lowa State University 


Key Words and Phrases: elliptic integrals, logarithms, inverse circular functions, inverse hyperbolic 
functions, R-functions 

CR Categories: 5.12 

Language: FORTRAN 


DESCRIPTION 


Robust and highly portable FORTRAN programs, implementing algorithms 
proved in [1], are presented for the symmetric elliptic integral of the first kind, 


Rr(x, y, 2) = ; | [(¢+ x)(¢+y)(t + z)])” dt, (1) 
0 


and a symmetric elliptic integral of the third kind, 


R(x, y, 2, p) = i [(é+ x)(¢+ y(t + z2)J'7(t + p)? dt. (2) 


All arguments are nonnegative, and if x = 0, the integrals are complete. The 
accessible range of argument values can be extended beyond the range admissible 
in the programs by using homogeneity: 


Rr(kx, ky, kz) = k7’?Re(x, y,z),  Ras(kx, ky, kz, kp) =k ??Rs(x, y, 2, p). 
The range of function values is indicated by 
M"'? = Rr(x, y,2z)<2m-*, Mr?? <= Rs (x, y, 2, p) < 5mi™”, 
= max{x, y, 2}, M, = max{M, p}, 
=min{x+y,x+2,y +2}, m, = min{m, p}. 


Enough simplifications occur in degenerate cases to justify separate programs 
for 


Re(x, y) = Rr(x, y, y) and Rop(x, y, Z) = Ra (x, y, 2, Z). (3) 
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The latter is an integral of the second kind, while Rc is an elementary function 
from which inverse circular functions can be computed if x < y and logarithms or 
inverse hyperbolic functions if x > y (see [1] for explicit formulas). The subroutine 
RJ calls RC in each cycle of iteration. All four subroutines proceed by successive 
applications of the duplication theorem, followed by expansion in Taylor series to 
fifth order. The programs require little space, convergence is linear but quite fast, 
serious cancellations do not occur, and accuracy is adjustable. 

Legendre’s elliptic integrals can be computed from these functions, but enu- 
meration of cases is avoided (because of symmetry) by expressing a given elliptic 
integral directly in terms of Rr, Rp, and R.,. Compact tables of elliptic integrals 
in terms of these functions are being prepared (e.g., see [2)]). 

The codes have been verified by PFORT, but fall short of complete portability 
because they involve two machine-dependent constants, LOLIM and UPLIM, 
which define the range of admissible arguments. No argument may be greater 
than UPLIM. The role of LOLIM is less simple, but in most cases it is a lower 
bound for the sum of two arguments. For Rc and Rr, which are hornogeneous of 
degree —4, LOLIM and UPLIM differ from the machine minimum and maximum, 
respectively, by a factor of only 5. For Rp and R,, which are homogeneous of 
degree —3, the limits are inevitably much more restrictive. Values of LOLIM and 
UPLIM are suggested in the program comments for several types of computers, 
and formulas are given for use with other machines. A larger (smaller) value of 
LOLIM (UPLIM) may be used with no ill effects, except that the range of valid 
arguments will be narrowed. Since the subroutine RJ calls RC, the values of 
LOLIM and UPLIM for the two programs must be coordinated as specified in 
the comments. 

Our codes have been modified by Dr. J.L. Schonfelder for inclusion in a future 
edition of the NAG library, and in the case of RC and RF his versions admit all 
machine-representable arguments. He uses LOLIM and UPLIM to define various 
regions in which different scaling procedures are used. This entails a significant 
elaboration of the codes, but will be valuable for users who need to work near the 
fringes of machine representability. 

The accuracy of each program is controlled by a variable called ERRTOL, 
which determines the maximum error committed in truncating a Taylor series at 
terms of fifth order. If lower precision is sufficient, a larger value of ERRTOL will 
speed up the program by requiring fewer iterations of the duplication theorem 
before computing the Taylor series. Decreasing ERRTOL by a factor of 10 yields 
six more decimal digits of accuracy at the expense of one or two more iterations. 
More precisely, decreasing ERRTOL by a factor of 4 requires one more iteration 
and reduces the error ultimately by a factor of 4° = 4096. Since required accuracy 
may vary from one run to another, ERRTOL is treated as an input variable. (Its 
value is set automatically when RC is called by RJ.) On the other hand, LOLIM 
and UPLIM are set within each subroutine because they will usually be fixed 
once and for all at a given installation. An exception to the last statement occurs 
because UPLIM in the case of RD depends on ERRTOL (essentially because the 
number of iterations depends on ERRTOL, and underflow in computing SIGMA 
becomes more likely in successive iterations as POWER4 decreases). For nearly 
all purposes ERRTOL may be replaced by 10~ in the formula for UPLIM, but 
users who need to admit very large arguments or who want 30 decimal digits of 
accuracy without losing robustness should recompute UPLIM from the value 
actually used for ERRTOL. 

The programs have been tested for robustness on an ITEL AS/6 computer by 
running them at extreme points of the region of valid arguments (such as X = 0 
and Y = UPLIM in the case of RC). In order to achieve robustness the Taylor 
series given in [1] had to be rearranged in terms of elementary symmetric 
functions because underflows occurred in computing the power sums s””’. By 
means of [1, e.g., (5.10) ] the series in [1, eq. (2.5) ] becomes 
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1 — {£2 + fEs + §ES — ZE2Es + rn, (4) 


where E, is the elementary symmetric function (see [1, Appendix]) of degree r in 
Xn, Yn, Zn. Similarly, the series in [1, (2.19) and (2.27) ] become 


1 — $F. +4E; — £F.+ ZEi + BEs — BEE + rn, (5) 


where E, is an elementary symmetric function of X,, Yn, Zn, Pn, Pn for the case 
of [1, (2.19)] and X,, Yn, Z,, Zn, Zn for [1, (2.27)]. In all cases, EF, = 0. 
Some check values are 


Ro (0, 3) = Rel, §) = 7, 
Reo(G, 2) = log. 2, 
Rr(0, 1, 2) = A = 1.31102 87771 46059 90523 24198, (6) 
Rv(0, 2, 1) = 3B = 37/4A = 1.79721 03521 03388 31115 98837, 
Rz(2, 3, 4, 5) = 0.14297 57966 71567 53833 23308. 


The lemniscate constants A and B are given to 50D in [3]. Consistency checks 
are provided in the program comments. Values of (log x)/(x — 1) and arctan x 
computed from library routines for the AS/6 computer agree well with those 
computed from RC, usually to within four units in the last (sixteenth) decimal 
place. There is similar agreement between RF and the FUNPACK routine for 
the complete elliptic integral K(k). Because of homogeneity a substantially wider 
range of values of k? can be used with RF than with FUNPACK. 
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[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service .] 
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aa 


DOUBLE PRECISION FUNCTION RC(X. Y., ERRTOL, IERR) 


THIS FUNCTION SUBROUTINE COMPUTES THE ELEMENTARY INTEGRAL 
RC(X, Y) = INTEGRAL FROM ZERO TO INFINITY OF 


4/2 ~4 
(1/2) (T#X) (T+¥) DT, 


WHERE X IS NONNEGATIVE AND Y IS POSITIVE. THE DUPLICATION 
THEOREM IS ITERATED UNTIL THE VARIABLES ARE NEARLY EQUAL, 
AND THE FUNCTION IS THEN EXPANDED IN TAYLOR SERIES TO FIFTH 
ORDER. LOGARITHMIC, INVERSE CIRCULAR. AND INVERSE HYPER- 
BOLIC FUNCTIONS CAN BE EXPRESSED IN TERMS OF RC. REFERENCE: 
B. ©. CARLSON, COMPUTING ELLIPTIC INTEGRALS BY DUPLICATION. 
NUMER. MATH. 33 (1979), 1-16. CODED BY B. C. CARLSON AND 
ELAINE M. NOTIS. AMES LABORATORY-DOE, IOWA STATE UNIVERSITY, 
AMES, IOWA 50011. MARCH 1. 1980. 


CHECK BY ADDITION THEOREM: RC(X,X+Z) + RCCY,Y+Z) = RC(O, 27), 
WHERE X, Y, AND Z ARE POSITIVE AND X # Y = Z * Z. 
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re) 


10 


30 


40 


INTEGER IERR, PRINTR 

DOUBLE PRECISION Ci. Ce, ERRTOL, LAMDA, LOLIM 

DOUBLE PRECISION MU. S, SN. UPLIM, X, XN. Y. YN 
INTRINSIC FUNCTIONS USED: DABS, DMAX1, DSQRT 


PRINTR IS THE UNIT NUMBER OF THE PRINTER. 
DATA PRINTR /6/ 


LOLIM AND UPLIM DETERMINE THE RANGE OF VALID ARGUMENTS. 


LOLIM IS NOT LESS THAN THE MACHINE MINIMUM MULTIPLIED BY 5. 
UPLIM IS NOT GREATER THAN THE MACHINE MAXIMUM DIVIDED BY 5. 


ACCEPTABLE VALUES FOR: LOLIM UPLIM 

IBM 360/370 SERIES : 3. D-78 1. D+75 
CDC 6000/7000 SERIES : 1. D-292 1. D+321 
UNIVAC 1100 SERIES : 1. D-307 1. D+307 


WARNING: IF THIS PROGRAM IS CONVERTED TO SINGLE PRECISION, 
THE VALUES FOR THE UNIVAC 1100 SERIES SHOULD BE CHANGED TO 
LOLIM = 1.E--37 AND UPLIM = 1.E+37 BECAUSE THE MACHINE 
EXTREMA CHANGE WITH THE PRECISION. 


DATA LOLIM /3.D-78/, UPLIM /1.D+75/ 
ON INPUT: 


X AND Y ARE THE VARTABLES IN THE INTEGRAL RCCK,Y). 


ERRTGL IS SET TO THE DESIRED ERROR TOLERANCE. 
RELATIVE ERROR DUE TO TRUNCATION IS LESS THAN 
16 # ERRTOL #* 6 / (1 - 2 * ERRTOL?. 


SAMPLE CHOICES: ERRTOL RELATIVE TRUNCATION 
ERROR LESS THAN 


1.D-3 2.D-17 
3. D-3 2. D-14 
1.D-~2 2.D-11 
3. D-2 2. D-8 
1.)-1 2. D-5 


ON QUTPUT: 
X, Y¥, AND ERRTOL ARE UNALTERED. 
IERR IS THE RETURN ERROR CODE: 


TERR QO FOR NORMAL COMPLETION OF THE SUBROUTINE, 
TERR 1 FOR ABNORMAL TERMINATION. 


ou 


ee oe ce ee ee er ee ee 
WARNING: CHANGES IN THE PROGRAM MAY IMPROVE SPEED AT THE 
EXPENSE GF ROBUSTNESS. 


IF (X.LT. 0. DO. OR. Y. LE. 0. DO) GO TO 10 
IF (¢CX+¥). LT.LOLIM) GO TO 10 

IF (DMAX1(X. Y). LE. UPLIM) GO TO 20 
WRITE (PRINTR, 99999) 

WRITE (PRINTR, 99998) X, Y 


IERR = 1 

GO TO 50 

TERR = 0 

XN = X 

YN = Y 

MU = (XN+YN+YN) 7/3. DO 
SN = CYN+MU)/MU ~ 2. DO 


IF (DABS(SN). LT. ERRTOL) GO TO 40 
LAMDA = 2. DOX¥DSQRT (XN) #DSQRTCYN) + YN 
XN = (XN+LAMDA) #O. 25D0 


YN = (CYN+LAMDA) #0. 29D0 
GO TO 30 
Cl 3, DO/7. DO 


C2 = 9. D0/22). DO 
S = SN#SN#(O. SDO+SN#(CL+5N#(00. B75D0+SN#C2) )) 
RC = (1. DO+S)/DSQRT CMU) 
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4@Ht##H ERROR — 
SHX = | 


IF ONE OF THEM IS ZERO, 


INVALID ARGUMENTS PASSED TO RC) 


D23.16, 4X, 4HY =, D223. 16) 


re RHKEHHKHHHHHKKHHKKHHKHHHKHHHHHHHHKHHHHKHHKKHHEHHHHEHHRHKHHHKHHHKRHHKEH 


FUNCTION RF(X, Y, Z, ERRTOL, TERR) 


FUNCTION SUBROUTINE COMPUTES THE INCOMPLETE ELLIPTIC 


THE FIRST KIND, 
INTEGRAL FROM ZERO TO INFINITY OF 


“1/2 
(1/2) ¢T+X) (T+Y) 


“1/2 ~1/2 
(TZ) DT. 


AND Z ARE NONNEGATIVE AND AT MOST ONE OF THEM 


HHHHKAMHRHKRKHHHKRHHHHRHHHHRHHHHHHKRHHKHHHHHHHHHHHHHHHKHRHHHHKHHHE 


DOUBLE PRECISION FUNCTION RD(X,Y, Z, ERRTOL, IERR) 


C 
oO RETURN 

99999 FORMAT (1HO, 
99998 FORMAT (1H , 

END 

DOUBLE PRECISION 
C 
C THIS 
C INTEGRAL OF 
C RF(X,Y,Z) = 
C 
C 
C 
C 
C WHERE X, Y, 
C IS ZERO. 
C 
C 
C 
C 
Cc 
L 
C 
Cc 
C 
C WHERE X AND 
Cc POSITIVE. 
C 
C 


IF X OR Y IS ZERO, 


THIS FUNCTION SUBROUTINE COMPUTES AN INCOMPLETE ELLIPTIC 
INTEGRAL GF THE SECOND KIND, 


INTEGRAL FROM ZERO TO INFINITY OF 


-i/2 
(3/2) (CT +X) (T+Y¥) 


-1/2 ~3/a2 
(T+Z) DT, 

Y ARE NONNEGATIVE, X + Y IS POSITIVE, 

THE INTEGRAL IS COMPLETE. 


HHAHHALHHHKRHRHHHKHHHHHHHHHRHKHHHHKRHHKHHKRKHHHHRHHHHERHHRHRHREHRHEH 


DOUBLE PRECISION FUNCTION RJUC(X, Y. Z,P,ERRTOL, TERR) 


THIS 
INTEGRAL OF 
RICK, Y,Z,P) 


WHERE xX, Y, 
ZERO, AND P 
INTEGRAL IS 


OGOANDANANAAAAS 


FUNCTION SUBROUTINE COMPUTES AN INCOMPLETE ELLIPTIC 


THE THIRD KIND, 
= INTEGRAL FROM ZERO TO INFINITY OF 


~1/2 -1l/2 
(3/72) ¢0T+X) (T+Y) (T+Z) 


-1/2 =| 

(T+P) DT, 
AND Z ARE NONNEGATIVE. AT MOST GNE OF THEM IS 
IS POSITIVE. IF X OR Y QR Z IS ZERO, THE 
COMPLETE. 
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ALGORITHM 578 
Solution of Real Linear Equations 
in a Paged Virtual Store [F4] 


J. J. DU CROZ and S. M. NUGENT 
NAG Central Office, England 

J. K. REID 

AERE Harwell, England 

and 

D. B. TAYLOR 

University of Edinburgh, Scotland 


Key Words and Phrases: Gaussian elimination, paged virtual store 
CR Categories: 5.14 
Language: FORTRAN 


DESCRIPTION 


BLCFAC is a routine for performing Gaussian elimination with partial pivoting 
on a real square matrix A, with the operations on blocks of consecutive columns 
grouped together to minimize the number of page swaps on a machine with a 
paged virtual store, as described in [1]. Given that A has been factorized by 
BLCFAC, the routine BLCSOL will solve either of the systems 


AX=B 
or 
A'X=B 


with multiple right-hand sides. The operations on blocks of consecutive right- 
hand sides are grouped together for the same reason. BLCFAC and BLCSOL are 
essentially the same as the routines FOIBTF and FO4AYF in the NAG FORTRAN 
Library. 

The routines need two environmental parameters, which are supplied in the 
functions SRELPR and NSACT. SRELPR is the relative precision, as defined in 
[2]; NSACT is the target active set size in real storage units. The choice of a 
suitable value, which depends on the particular machine, is discussed in Section 
4 of [1]. The value zero is suitable on nonpaged machines. 
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DOCUMENTATION 


The routines are fully documented by embedded comments. 


EXAMPLE 


To solve the set of linear equations Ax = b, where 
3 —6 12 3 —3 
_ [-l 4 -10 —1 1 
A=] 4 -13 30 2] and b=) 4 
2 -11 30 #7 9 


20 


99999 
99998 
99997 


INTEGER I, IA, IB, IFAIL, IR, J, N, NIN, NOUT' 
LOGICAL TRANS 

REAL A(5, 5), B(5), P(5) 

DATA NIN /5/, NOUT /6/ 

N=4 

READ (NIN, 99999) ((A(I, J), J = 1, N), l= 1, N) 
ITA =5 

IFAIL = 1 

GAUSSIAN ELIMINATION 

CALL BLCFAC(N, A, IA, P, IFAIL) 

IF (IFAIL.EQ.0) GO TO 20 

WRITE (NOUT, 99998) IFAIL 

STOP 

IR=1 

TRANS = .FALSE. 

READ (NIN, 99999) (B(I), I = 1, N) 

IB=5 

APPROXIMATE SOLUTION OF LINEAR EQUATIONS 
CALL BLCSOL(N, IR, TRANS, A, IA, P, B, IB, TAIL) 
WRITE (NOUT, 99997) (B()), I = 1, N) 

STOP 

FORMAT (4F5.0) 

FORMAT (25HOBRROR IN BLCFAC IFAIL = , [2) 
FORMAT (10HOSOLUTIONS/(1H , F4.1)) 

END 


The following are suitable data: 


3 —6 12 3 
1 Ao - 10 =] 
4 -13 30 2 
2 —l11 30. —7 
—3 1 -9 9 


and the following results should be obtained: 


SOLUTIONS 


—1.0 
3.0 
1.0 
2.0 


REFERENCES 
1. Du Croz, J.J., NUGENT, S.M., Rerp, J.K., AND TAyLor, D.B. Solving large full sets of linear 
equations in a paged virtual store. ACM Trans. Math. Softw. 7, 4 (Dec. 1981), 527-536. 
2. Forp, B. Parameterization of the environment for transportable numerical software. ACM 
Trans. Math. Softw. 4, 2 (June 1978), 100-103. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 


ACM Algorithms Distribution Service.] 


AAAAANDAAACAARAAARAANDAO AQAAADAANQAAAARANDAANAARAARAAAAARAARAADAAARAARAARAANAAAARANDNDANDNAAADANAAAANAAANAAANDA 


SUBROUTINE BLCFAC(N, A, IA, P, IERR) 


BLCFAC FACTORIZES A REAL MATRIX BY GAUSSIAN ELIMINATION WITH 
PARTIAL PIVOTING . IT IS ORGANIZED SO THAT BLOCKS OF 
CONSECUTIVE COLUMNS ARE TREATED TOGETHER FOR EFFICIENCY ON A 
PAGED MACHINE. 


THE ROUTINE FACTORIZES THE INPUT MATRIX A AS P * L * U, 

WHERE P IS A PERMUTATION MATRIX, L IS A LOWER TRIANGULAR 
MATRIX , AND U IS AN UPPER TRIANGULAR MATRIX WITH UNIT 
DIAGONAL ELEMENTS. WHEN CHOOSING A PIVOT, THE ROUTINE 
IMPLICITLY SCALES THE ROWS TO HAVE LARGEST ELEMENT 1.0. THE 
ROUTINE TESTS THE SIZE OF THE IMPLICITLY SCALED PIVOT ELEMENT 
TO CHECK FOR APPROXIMATE SINGULARITY. 


PARAMETERS— 
N INTEGER 


ON ENTRY, N SPECIFIES THE ORDER OF THE MATRIX A 
(N.GT.@). UNCHANGED ON EXIT. 


A REAL ARRAY OF DIMENSION (IA,N) 
BEFORE ENTRY, A(I,J) MUST BE SET TO THE (I,J)TH ELEMENT 
OF THE MATRIX A, FOR I =1,...,N AND J = 1,...,N. 


ON SUCCESSFUL EXIT, THE STRICT UPPER TRIANGLE OF A IS 
OVERWRITTEN BY THE CORRESPONDING ELEMENTS OF U (THE 
UNIT DIAGONAL ELEMENTS OF U ARE NOT STORED) AND THE 
LOWER TRIANGLE OF A IS OVERWRITTEN BY THE MULTIPLIERS 
USED IN THE GAUSSIAN ELIMINATION (IT DOES NOT CONTAIN 
THE MATRIX L AS SUCH - THE SUBDIAGONAL ELEMENTS ARE 
PERMUTED) . 


IA INTEGER 
ON ENTRY, IA SPECIFIES THE FIRST DIMENSION OF A AS 
DECLARED IN THE CALLING (SUB)PROGRAM (IA.GE.N). 
UNCHANGED ON EXIT. 


P REAL ARRAY OF DIMENSION (N) 
ON SUCCESSFUL EXIT, P(1) CONTAINS THE ROW INDEX OF 
THE I-TH PIVOT, FOR I = 1,...,N. 


IERR INTEGER 
IERR IS AN ERROR INDICATOR. ON EXIT 
IERR = @ IF NO ERROR HAS OCCURRED 
IERR = 1 IF ON ENTRY IA-‘LT.N 
IERR = 2 IF THE MATRIX HAS A ROW CONSISTING ENTIRELY 

OF ZEROS 

IERR = 3 IF THE MATRIX LS APPROXIMATELY SINGULAR 
IERR = 4 IF ON ENTRY N.LT.1 


SUBROUTINE BLCSOL(N, IR, TRANS, A, IA, P, B, IB, IERR) 


BLCSOL CALCULATES THE APPROXIMATE SOLUTION OF A SET OF REAL 
LINEAR EQUATIONS WITH MULTIPLE RIGHT HAND SIDES A * X = B, 
AFTER A OR ITS TRANSPOSE HAS BEEN FACTORIZED BY BLCFAC. 

IT IS ORGANIZED SO THAT BLOCKS OF CONSECUTIVE RIGHT HAND 
SIDES ARE TREATED TOGETHER FOR EFFICIENCY ON A PAGED MACHINE. 


PARAMETERS— 


N INTEGER 
ON ENTRY, N SPECIFIES THE ORDER OF THE MATRIX A 
(N.GT.@). UNCHANGED ON EXIT. 


IR INTEGER 
ON ENTRY, IR SPECIFIES THE NUMBER OF RIGHT HAND SIDES 
I.E. THE NUMBER OF COLUMNS OF THE MATRIX B (IR.GT.@). 


BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLF 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
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C 


NQDAANAAANQAAAAAANAAARAANAARANRBANANAAAAARAAAAG 


TRANS 


IA 


IB 


TERR 


UNCHANGED ON EXIT. 


LOGICAL 

ON ENTRY, TRANS MUST BE TRUE IF THE TRANSPOSE OF A 
WAS FACTORIZED BY BLCSOL AND FALSE OTHERWISE. 
UNCHANGED ON EXIT.° 


REAL ARRAY OF DIMENSION (IA,N) 


BEFORE ENTRY, A MUST CONTAIN THE FACTORIZATION OF THE 


MATRIX A OR ITS TRANSPOSE AS RETURNED BY THE 
ROUTINE BLCSOL. UNCHANGED ON EXIT. 


INTEGER 

ON ENTRY, IA SPECIFIES THE FIRST DIMENSION OF A AS 
DECLARED IN THE CALLING (SUB)PROGRAM (IA.GE.N). 
UNCHANGED ON EXIT. 


REAL ARRAY OF DIMENSION (N) 
BEFORE ENTRY, P MUST CONTAIN THE DETAILS OF THE ROW 
PERMUTATIONS AS RETURNED BY THE ROUTINE BLCFAC 


REAL ARRAY OF DIMENSION (IB, IR) 

BEFORE ENTRY, B MUST CONTAIN THE MATRIX OF RIGHT 
HAND SIDES B. 

ON SUCCESSFUL EXIT, B IS OVERWRITTEN BY THE MATRIX 
OF SOLUTIONS X. 


INTEGER 

ON ENTRY, IB SPECIFIES THE FIRST DIMENSION OF B AS 
DECLARED IN THE CALLING (SUB)PROGRAM (IB.GE.N). 
UNCHANGED ON EXIT. 


INTEGER 
TERR IS AN ERROR INDICATOR. ON EXIT 


IERR = @ IF NO ERROR HAS OCCURRED 
TERR = 1 IF ON ENTRY IA.LT.N 

TERR = 2 IF ON ENTRY IR.LT.1 

TERR = 3 IF ON ENTRY IB.LT.N 

IERR = 4 IF ON ENTRY N-LT.1 


BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 
BLS 


18¢@ 
190 
200 
210 
22¢ 
230 
240 
250 
260 
27 
280 
290 
300 
310 
326 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
45@ 
460 
47 
480 
490 
500 
510 
520 
530 
540 
55¢@ 
56¢@ 
570 
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ALGORITHM 579 
CPSC: Complex Power Series Coefficients 
[D4] 


BENGT FORNBERG 
California Institute of Technology 


Key Words and Phrases: numerical differentiation, Taylor series coefficients, analytic functions 
CR Categories: 5.16 
Language: FORTRAN 


DESCRIPTION 


An algorithm CPSC is presented here. It evaluates numerically the leading 
coefficients in a power series expansion of an analytic function (or, equivalently, 
a number of leading derivatives of an analytic function). A detailed description of 
the theoretical background of the code is given in [1], together with some 
warnings about cases in which full accuracy may not be reached. 

Such cases are 


(1) very low-order polynomials (for example, f(z) = 1 + 2); 

(2) functions whose Taylor expansions contain very large isolated terms (for 
example, f(z) = 10° + (1/(1 — z))); 

(3) certain entire functions (for example, f(z) = e”); 

(4) functions whose radius of convergence is limited by a branch point at which 
the function remains many times differentiable (for example, f(z) = (1 + z)"® 
log(1 + z) expanded around z = 0). 


In the case 1, the routine will normally fail to even approximate the correct 
answer. In cases 2, 3, and 4, problems are normally encountered only if large 
numbers of coefficients are wanted (e.g., more than 30). The supplied error 
estimate will, in most of these cases, give correct information about the lowered 
accuracy. 

Inevitably there is a risk that the routine will attempt to evaluate the given 
function exactly at a singularity. This will happen, for example, for f(z) = 1/ 
(1 — z) expanded around zero if the initial radius is of the form r = 2”, with p 
any integer. The risk for such exact coincidences in floating point can be mini- 
mized by choosing “irregular” initial radii. A practical procedure may be to start 
each case by the obtained final radius from a previous case. 
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REFERENCES 
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(Dec. 1981), 512-526. 


ALGORITHM 


The user must enter the machine accuracy in a data statement. The routine 
adjusts the calculations accordingly in order to obtain the best possible accuracy. 
However, since a few decimal places are always lost in this routine, we do not 
recommend its general use if the machine accuracy is less than 10 significant 
decimal places. For example, for use on IBM Systern 370 machines, we recom- 
mend double or quadruple precision. The code below is for IBM double precision. 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service .] 


CPSC - COMPLEX POWER SERIES COEFFICIENTS 
BY BENGT FORNBERG 


C 
Cc 
Cc 
C 
C ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE, DECEMBER 1981 
C 
PROGRAM TEST (OUTPUT) 
C 
C THIS PROGRAM WITH THE FUNCTION F BELOW USES CPSC TO EVALUATE 
C THE LEADING DERIVATIVES OF F(Z) = CEXP(Z)/(CSIN(Z) **3+CCOS(Z) **3) 
C AT Z= OQ. 
EXTERNAL F 
DIMENSION A(51),IRANGE(4),ER(51) 
COMPLEX A 
DATA LRANGE/6,12,25,51/ 
DO 1@ I=1,4 
IR = ILRANGE(L) 
R= 1. 
CALL CPSC(F,(@.,@.),IR,1,R,A,ER) 
WRITE(6,2@) I 
WRITE(6,3@) (A(J),J=1, IR) 
1@ WRITE(6,40) (ER(J),J=1, IR) 
20 FORMAT(/2@H DERIVATIVES , RANGE, 13) 
3@ FORMAT (4(1X,E18.10,E9.1)) 
4Q@ FORMAT(/17H ESTIMATED ERRORS/ (1X, 16E8.1)) 
STOP 
END 
COMPLEX FUNCTION F(Z) 


a 


TEST FUNCTION FOR USE WITH CPSC. 


COMPLEX Z 

F = CEXP(Z)/(CSIN(Z) **3+CCOS (Z) **3) 
RETURN 

END 


SUBROUTINE CPSC(F,Z,N,IC,R, RS, ER) 
EVALUATION OF COMPLEX POWER SERIES COEFFICIENTS OR DERIVATIVES. 


*** INPUT PARAMETERS *** 

F COMPLEX FUNCTION, OF WHICH THE COEFFICIENTS OR DERIVATIVES 
ARE SOUGHT. THIS FUNCTION MUST BE DECLARED EXTERNAL IN THE 
CALLING PROGRAM. 

Z COMPLEX POINT AROUND WHICH F SHALL BE EXPANDED OR AT WHICH 
DERIVATIVES SHALL BE EVALUATED. 

N INTEGER, NUMBER OF COEFFICIENTS OR DERIVATIVES WANTED. 

N MUST BE GE 1 AND LE 51. 

IC SELECTS BETWEEN POWER SERIES COEFFICIENTS AND DREIVATIVES. 
IC .EQ. @ ROUTINE RETURNS POWER SERIES COEFFICIENTS IN RS 
IC .NE. ® ROUTINE RETURNS DERIVATIVES IN RS . 

*kk INPUT AND OUTPUT PARAMETER *** 
R INITIAL RADIUS USED IN SEARCH FOR OPTIMAL RADIUS. THE RESULTING 


ANANANAANANANMNAAANAAAAN 
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ARAAAAARANAARAANAaA OOOO a aa 


oo eS ae 


Oo 


aa 


Qa 


RADIUS IS LEFT IN R. THE PROVIDED GUESS MAY BE IN ERROR WITH AT 
MOST A FACTOR OF 3.E4 . 
**k* OUTPUT PARAMETERS *** 

RS COMPLEX ARRAY RS(N) CONTAINING THE N FIRST 
COEFFICIENTS (CORRESPONDING TO THE POWERS @ TO N-1) OR DERIVA- 
TIVES (ORDERS @ TO N-1l) . 

ER REAL ARRAY ER(N) CONTAINING ERROR ESTIMATES FOR THE 
.NUMBERS IN RS(N). 


DIMENSION IP.(32),A(64),RS(N),ER(N),RT(51,3),FV(6), 
* IW(7),SC(4),RV(3),C(4), FC(3) 
COMPLEX F,A,V,RS,RT,FV,U,W,T,Z,RV,RQ,S, XK, MULT, CO 


LIST OF THE VARIABLES INITIALIZED IN THE DATA STATEMENT BELOW. 
EPS MACHINE ACCURACY. THIS CONSTANT HAS TO BE SUPPLIED BY 
THE USER. IN THIS LIST, IT IS GIVEN AS 1.E-14 CORRESPONDING 
TO THE 48 BIT FLOATING POINT MANTISSAS ON CDC CYBER MACHINES. 
IND INTEGER FLAG. 
L2 INTEGER FLAG. 
TW DRC Oi ty Pea eg Bh ae ob 7. 
IP PERMUTATION CONSTANTS FOR THE FFT. 
RV CONSTANTS FOR THE LAURENT SERIES TEST . 


DATA EPS/1.E-14/, IND/@/,L2/1/, IW/1,2,4,8,16,32,64/, 

* TIP/64,32,48,16, 56, 24,40, 8, 60, 28, 44,12, 52, 20, 36,4, 62, 30, 46,14, 
* 54,22,38,6,58,26,42,10, 50,18, 34, 2/, 

* RV/(-.4,.3),(.75 +2), (.02,-. 06) / 


STATEMENT FUNCTION FOR MULTIPLICATION OF A COMPLEX NUMBER 
BY A REAL NUMBER. 


MULT (RE,CO) = CMPLX(RE*REAL(CO) , REXAIMAG (CO) ) 
EVALUATE SOME CONSTANTS THE FIRST TIME THE CODE IS EXECUTED. 


IF(IND.EQ.1) GOTO 2¢ 
IND = 1 

SCCL)> = 4125 

C(1) = EPS**(1./28.) 
EP6 = C(1)**6 

PI = 4.*ATAN(1.) 
FV(1) = (-1.,¢@.) 
FV(2) = (@.,-1.) 

RL = SQRT(.5) 


RA = 1./R1 
FV(3) = CMPLX(R1,-R1) 
DO 1@ 1=2,4 


SC(I) = .5*SC(I-1) 

C(I) = SQRT(C(I-1)) 

ANG = PI*SC(I-1) 
10 FV(I+2) = CMPLX(COS (ANG) ,-SIN(ANG) ) 
20 CONTINUE : 


START EXECUTION. 


IF(N.GT.51.OR.N.LT.1) GOTO 260 


LF = @ 
NP = @ 
M=@0 

NR = -1 


FIND IF A FFT OVER 8, 16, 32, OR 64 POINTS SHOULD BE USED. 


KL = 1 
IF(N.GT.6) KL=2 
LIF(N.GT.12) KL=3 
IF(N.GT.25) KL=4 


KM = KL+2 

KN = 7-KM 

IX = IW(KM+1) 
IS = IW(KN) 


30 V = CMPLX(R,9.) 
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C FUNCTION VALUES OF F ARE STORED READY PERMUTATED FOR THE FFT. 
C 
DO 4@ I=IS,32,1S 
IQ = IP(I) 
V = V*FV(KM) 
A(IQ) = F(Z+V) 
4@ A(IQ-1) = F(Z-V) 
LN = 2 
IN=1 
Cc 
C THE LOOP DO 7@ ... CONSTITUTES THE FFT. 
Cc 
DO 7@ L=1,KM 
U = (1.,9.) 
W = FV(L) 
DO 6@ J=1,JIN 
DO 5@ I=J,1X,LN 
IT = I+JN 
T = AC(IT)*U 
A(IT) = A(I)-T 
50 A(I) = ACI)+T 
60 U = U*W 
LN = LN+LN 
70 JIN = JIN+JIN 
CX 
B 


0. 
1. 


a 


TEST ON HOW FAST THE COEFFICIENTS OBTAINED DECREASE. 


DO 8@ I=1,1X 
CT = CABS(A(I))/B 
IF(CT.LT.CX) GOTO 80 
CX-= CT 
INR = I 
80 B= BXC(KL) 
IF(M.LE.1) GOTO 10@ 


ESTIMATE OF THE ROUNDING ERROR LEVEL FOR THE LAST RADIUS. 


aaa 


ER(1) = CX*EPS 
DO 9% I=2,N 
9@ ER(I) = ER(I-1)/R 
100 SF = SC(KL) 
pO 11@ I=1,1X 
A(L) = MULT(SF,A(I)) 
110 SF = SF/R 
Ll = 12 
L2 = 1 
IF(INR.GT.IW(ka1)) GOTO 150 
IF(LF.EQ.1) GOTO 14@ 
Cc 
C TEST IF THE SERIES IS A TAYLOR OR A LAURENT SERIES. 
c 
SR = @. 
SP = @. 
DO 13@ J=1,3 
RQ = MULT(R,RV(J)) 
S = A(LX) 
DO 12@ I=2,1X 
IA = IX+1-I 
120 S = S*RQ+A(IA) 
CP = CABS(S) 
IF(CP.GT.SP) SP=CP 
CM = CABS(S-F(Z+RQ) ) 
13@ IF(CM.GT.SR) SR=CM 
IF(SR.GT.1.E-3*SP) GOTO 150 
LF = 1 
146 L2 = -1 


C 
C DETERMINATION OF THE NEXT RADIUS TO BE USED. 
C 
15@ IF(NR.GE.9) GOTO 16¢ 
FACT = 2. 
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IF(L2.EQ.1) FACT=.5 
Ll = L2 
NR = @ 
16@ IF(L1.NE.L2) GOTO 18¢ 
IF(NR.GT.@) GOTO 170 
NP = NP+1 
IF(NP-15) 196,199,260 
17@ FACT = 1./FACT 
18@ FACT = 1./SQRT(FACT) 
NR = NR+1 
19@ 
NR-KL-1 


THE RESULTS FOR THE LAST THREE RADII ARE STORED. 


aan 


DO 260 I=1,N 
200 RT(I,M) = A(T) 
IF(M.EQ.1) GOTO 22 


EXTRAPOLATION. 


aaa 


DO 21% I=1,N 
XK = RT(I,M-1)-RT(I,M) 
210 RI(I,M-1) = RT(L,M)-MULT(FC(M-1) , XK) 
IF(M.EQ.3) GOTO 230 


CALCULATION OF THE EXTRAPOLATION CONSTANTS. 


QaAQa 


220 FC(M) = 1.5+SIGN(.5, FACT-1.) 
IF(M.EQ.2) FC(M)=FC(M)+RA 
IF(FACT.GT.1.) FC(M)=-FC(M) 

GOTO 3¢@ 
23@ FC(3) = FC(1) *FC(2)/(FC(1)+FC(2)4+1.) 


FINAL EXTRAPOLATION AND ERROR ESTIMATE. 


aaa 


DO 24@ I=1,N 
XK = RT(I,1)-RT(I, 2) 
ER(T) ER(1)+EP6*CABS (XK) 
240 = RS(T) RT(I,2)-MULT(FC(3) , XK) 


MULTIPLY POWER SERIES COEFFICIENTS AND ERROR ESTIMATE BY FACTORIALS 
IF DERIVATIVES WANTED. 


aAaAaAA 


IF(IC.EQ.%) RETURN 
FAC = @. 
FACT = l. 
DO 250 I=1,N 
RS(I) = MULT(FACT, RS(I)) 
ER(L) = FACT*ER(I) 
FAC = FACHl. 
250 FACT = FACT*FAC 
RETURN 
c 
C ERROR RETURN. 
C 
260 DO 27@ I=1,N 
RS (I) (@.,9%.) 
270 ER(I) = 1.E1¢ 
RETURN 
END 
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ALGORITHM 580 | 
QRUP: A Set of FORTRAN Routines for 
Updating QR Factorizations [F5] 


A. BUCKLEY 
Concordia University, Canada 


Key Words and Phrases: matrix factorization, orthogonalization 
CR Categories: 5.14 
Language: FORTRAN 


DESCRIPTION 


This algorithm is a translation into FORTRAN of the ALGOL routines published 
by Daniel et al. [2]. Given an m X n matrix A with m = n, these routines compute 
a QR factorization of A based on the Gram-Schmidt orthogonalization process, 
and they provide for updating the factorization when rows or columns are added 
to or deleted from A. Also the factors may be updated when A is modified by the 
addition or subtraction of a rank one matrix. 

The translation is in most instances straightforward, but there are some points 
that need to be noted. Most of these are discussed in detail in the descriptive 
routine DESCRB, which is part of the algorithm. 

However, a few comments belong here. Notice that DESCRB contains both a 
complete description of the routines and a fairly lengthy set of tests to ensure the 
accuracy of the translation. The tests basically consist of an initial factorization. 
of a 7 X 7 Hilbert matrix, followed by random deletion of rows and columns of 
the matrix until it is just 1 x 1, after which the rows and columns are, in a random 
order, reinserted to recreate the original matrix. Rank one matrices are introduced 
(then deleted) at several points as well. At each step, the factorization is updated 
and its accuracy is checked against the matrix being factored. A copy of the 
output from an execution of the tests follows the algorithm. The routines have 
also been tested through their use in an implementation of the minimization 
algorithm described in [1]. 

The translation is written in a portable subset of American National Standard 
FORTRAN, 1966, and has been thoroughly checked by the PFORT verifier. 
Except for some minor points noted in the routine DESCRB, the code is machine 
independent. 

The routines are written simultaneously in single and double precision. As 
listed, compilation will give a single-precision version. It is straightforward, 


———— 


Received 15 August 1979; revised 22 August 1980; accepted 1 April 1981 


Permission to copy without fee all or part of this material is granted provided that the copies are not 
made or distributed for direct commercial advantage, the ACM copyright notice and the title of the 
publication and its date appear, and notice is given that copying is by permission of the Association 
for Computing Machinery. To copy otherwise, or to republish, requires a fee and/or specific 
permission. 

This work was supported by NSERC Grant A8962. 

Author’s address: Mathematics Department, Layola Campus, Concordia University, 7141 Sherbrooke 
Street W, Montreal, Que., H4B 1R6, Canada. 

© 1981 ACM 0098-3500/81/1200-0548 $00.75 


ACM Transactions on Mathematical Software, Vol. 7, No. 4, December 1981, Pages 548-549. 


COLLECTED ALGORITHMS (cont.) 580-P 2- Rl 


however, to obtain a double-precision version: just follow the simple instructions 
in DESCRB to interchange a few well-marked statements. 

Notice that the basic linear algebra operations, such as taking norms or 
computing inner products, are done via calls to the BLAS described by Lawson 
et al. [3]. These routines are available through the International Mathematical 
and Statistical Libraries, Inc.,' or through SIAM.” 
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QRUP: A Set of FORTRAN Routines for Updating QR Factorizations [A. 
Buckley, ACM Trans. Math. Softw. 7, 4 (Dec. 1981), 548-549] 


A. Buckley [Received 20 May 1982; accepted 20 May 1982] 
Department of Management Information Systems, University of Arizona, Tucson, 
AZ 85721. 


In two subprograms the functions DNRM2() and DDOT() are not declared to 
be DOUBLE PRECISION as they should be. 

In program unit DESCRB(), sequence numbers QRUP 139 and QRUP 140 
should be modified to read: 


REAL A, ASS, SDOT, COL, GLRMAX, OMEGA 
Ci!!! DOUBLE PRECISION A, ASS, DDOT, COL, GLRMAX, OMEGA 


In program unit ORTCOL(), sequence numbers QRUP 762 and QRUP 763 
should be modified to read: 


REAL SDOT, SNRM2, OMEGA, ONE, ONENEG, Q, RHO 
C!!!] DOUBLE PRECISION DDOT,DNRM2, OMEGA, ONE, ONENEG, Q, RHO 
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ALGORITHM 581 — 
An Improved Algorithm for Computing the 
Singular Value Decomposition [F1] 


TONY F. CHAN 
Department of Computer Science, Yale University 


Categories and Subject Descriptors: D.3.2 [Programming Languages]: Language Classifications— 
FORTRAN; G.1.3 [Numerical Analysis]: Numerical Linear Algebra—pseudoinverses; G.1.6 [Numer- 
ical Analysis]: Optimizations—/east squares. methods 


General Terms: Algorithms 


Additional Key Words and Phrases: singular-value decomposition 


DESCRIPTION 


The set of FORTRAN subroutines given here is an implementation of the 
algorithm [1] for computing the Singular Value Decomposition (SVD) of a general 
m by n rectangular matrix A defined as 


A=UWV'", 


where U is an m X min(m,n) matrix containing the left singular vectors, W is a 
diagonal matrix of size min(m, n) containing the singular values, and V is an 
n X min(m, n) matrix containing the right singular vectors. Note that m is allowed 
to be greater than or less than n. For ease of presentation, we assume m to be 
greater than or equal to n in the following discussion. 

The algorithm is an improvement of the Golub-Reinsch algorithm [4], which 
is implemented in subroutines SVD and MINFIT in EISPACK [3] and in 
subroutine SSVDC in LINPACK [2]. It should be more efficient than the 
Golub-Reinsch algorithm when m is approximately larger ti1an 2n, as is the case 
in many least squares applications. 

The algorithm has a hybrid nature. When m is about equal to n, the 
Golub-Reinsch algorithm is employed. When the ratio m/n is larger than a 
threshold value, which is determined by detailed operation counts [1], the 
improved algorithm is used. 

The improved algorithm first computes the QR factorization of A using House- 
holder transformations, and then uses the Golub-Reinsch algorithm on R. A 
further improvement over the Golub-Reinsch algorithm is when the left singular 
vectors are to be accumulated and saved. Here, instead of accumulating the 
Givens transformations (in the second phase of the algorithm where the singular 
values of the bidiagonal matrix are computed) on the m X n matrix containing 
the left singular vectors, we accumulate them on a temporary n X n matrix. This 
requires a small overhead in storage of an n X n matrix (small compared with 
m Xn) but offers big savings in time. 
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An additional feature of the new algorithm is that it can accumulate all the left 
orthogonal transformations on a number of given vectors, which can then be used 
in computing least squares solutions. In this fashion, it is similar to the EISPACK 
routine MINFIT. 

There are three main routines in the package: 


HYBSVD: This is the main routine which implements the hybrid algorithm. 

MGNSVD: This performs the same thing as HYBSVD, except that it assumes 
m .ge. n. 

GRSVD: This is a slightly modified version of routine SVD in EISPACK 
which implements the Golub-Reinsch algorithm. 


Besides, there are two utility routines: 


SSWAP: BLAS routine for swapping two vectors. 
SRELPR: Routine for computing the machine relative precision. 


These five routines must be used together. They have been tested extensively 
on the IBM 370/168, 360/91 at the Stanford Linear Accelerator Center, and on 
the DEC 2060 in the Computer Science Department at Yale. They produce 
results that agree (up to machine precision) with those produced by SVD, 
MINFIT, and SSVDC. They have been verified by PFORT verifier [5] for 
portability. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service (see page 91 for order form). ] 


SUBROUTINE HYBSVD(NA, NU, NV, NZ, NB, M, N, A, W, MATU, U, MATV, HYB 14 


* V, Z, B, IRHS, IERR, RV1) HYB 20 
INTEGER NA, NU, NV, NZ, M, N, IRHS, IERR, MIN@ HYB 36 
REAL A(NA,1), W(1), U(NU,1), V(NV,1), Z(NZ,1), B(NB,IRHS), RVL(1) HYB 46 
LOGICAL MATU, MATV HYB 50 

HYB 6@ 

THIS ROUTINE IS A MODIFICATION OF THE GOLUB-REINSCH PROCEDURE (1) HYB 7¢ 
T HYB 80 

FOR COMPUTING THE SINGULAR VALUE DECOMPOSITION A = UWV OF A HYB 9@ 
REAL M BY N RECTANGULAR MATRIX. U IS M BY MIN(M,N) CONTAINING HYB 10¢ 
THE LEFT SINGULAR VECTORS, W IS A MIN(M,N) BY MIN(M,N) DIAGONAL HYB 116 
MATRIX CONTAINING THE SINGULAR VALUES, AND V IS N BY MIN(M,N) HYB 120 
CONTAINING THE RIGHT SINGULAR VECTORS. HYB 130 
HYB 140 

THE ALGORITHM IMPLEMENTED IN THIS HYB 15¢ 


ROUTINE HAS A HYBRID NATURE. WHEN M IS APPROXIMATELY EQUAL TO N, HYB 16¢@ 
THE GOLUB-REINSCH ALGORITHM IS USED, BUT WHEN EITHER OF THE RATIOSHYB 176 


M/N OR N/M IS GREATER THAN ABOUT 2, HYB 18¢ 
A MODIFIED VERSION OF THE GOLUB-REINSCH HYB 190 
ALGORITHM IS USED. THIS MODIFIED ALGORITHM FIRST’ TRANSFORMS A. HYB 200 

T HYB 2106 
INTO UPPER TRIANGULAR FORM BY HOUSEHOLDER TRANSFORMATIONS L HYB 226 


AND THEN USES THE GOLUB-REINSCH ALGORITHM TO FIND THE SINGULAR HYB 230 
VALUE DECOMPOSITION OF THE RESULTING UPPER TRIANGULAR MATRIX R. HYB 246 
WHEN U IS NEEDED EXPLICITLY IN THE CASE M.GE.N (COR V IN THE CASE HYB 25¢ 
M.LT.N), AN EXTRA ARRAY Z (OF SIZE AT LEAST HYB 260 
MIN(M,N)**2) IS NEEDED, BUT OTHERWISE Z IS NOT REFERENCED HYB 276 
AND NO EXTRA STORAGE IS REQUIRED. THIS HYBRID METHOD HYB 286 


AANgQAANANANAaNANARAaAaANnananaaAaaanaanna 


COLLECTED ALGORITHMS (cont.) 


AAQAANRQAQAANNAANAAARAAGAANARAAAANAARANANAAANAANANAANAARAANAANANANAAMAANMNMAAMAANNMNANNANAAMAANANDNANANANDANAMNAANANAANANAaANAAAN 


SHOULD BE MORE EFFICIENT THAN THE GOLUB-REINSCH ALGORITHM WHEN 


M/N OR N/M IS LARGE. FOR DETAILS, SEE (2). 


WHEN M .GE. N, 

HYBSVD CAN ALSO BE USED TO COMPUTE THE MINIMAL LENGTH LEAST 
SQUARES SOLUTION TO THE OVERDETERMINED LINEAR SYSTEM A*X=B. 
IF M .LT. N (I.E. FOR UNDERDETERMINED SYSTEMS), THE RHS B 
IS NOT PROCESSED. 


NOTICE THAT THE SINGULAR VALUE DECOMPOSITION OF A MATRIX 
IS UNIQUE ONLY UP TO THE SIGN OF THE CORRESPONDING COLUMNS 


OF 


U AND V. 


THIS ROUTINE HAS BEEN CHECKED BY THE PFORT VERIFIER (3) FOR 
ADHERENCE TO A LARGE, CAREFULLY DEFINED, PORTABLE SUBSET OF 
AMERICAN NATIONAL STANDARD FORTRAN CALLED PFORT. 


REFERENCES : 


(1) 


(2) 


(3) 


ON 


GOLUB,G.H. AND REINSCH,C. (1970) 'SINGULAR VALUE 
DECOMPOSITION AND LEAST SQUARES SOLUTIONS,' 
NUMER. MATH. 14,403-42, 1970. 


CHAN,T.F. (1982) 'AN IMPROVED ALGORITHM FOR COMPUTING. 
THE SINGULAR VALUE DECOMPOSITION,' ACM TOMS, VOL.8, 
NO. 1, MARCH, 1982. 


RYDER,B.G. (1974) 'THE PFORT VERIFIER,' SOFTWARE - 
PRACTICE AND EXPERIENCE, VOL.4, 359-377, 1974. 


INPUT: 


NA MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL 
ARRAY PARAMETER A AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT. NOTE THAT NA MUST BE AT LEAST 
AS LARGE AS M. 


NU MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL 
ARRAY U AS DECLARED IN THE CALLING PROGRAM DIMENSION 
STATEMENT. NU MUST BE AT LEAST AS LARGE AS M. 


NV MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL 
ARRAY PARAMETER V AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT. NV MUST BE AT LEAST AS LARGE AS N. 


NZ MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL 
ARRAY PARAMETER Z AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT, NOTE THAT NZ MUST BE AT LEAST ° 
AS LARGE AS MIN(M,N). 

NB MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL 
ARRAY PARAMETER B AS DECLARED IN THE CALLING PROGRAM 
DIMENSION STATEMENT. NB MUST BE AT LEAST AS LARGE AS M., 

M IS THE NUMBER OF ROWS OF A (AND U). 

N IS THE NUMBER OF COLUMNS OF A (AND NUMBER OF ROWS OF V). 

A CONTAINS THE RECTANGULAR INPUT MATRIX: TO BE DECOMPOSED. 


B CONTAINS THE IRHS RIGHT-HAND-SIDES OF THE OVERDETERMINED 
LINEAR SYSTEM A*X=B, IF IRHS .GT. @ AND M .GE. N, 


THEN ON OUTPUT, THE FIRST N COMPONENTS OF THESE IRHS COLUMNS 


T 


WILL CONTAIN U B. THUS, TO COMPUTE THE MINIMAL LENGTH LEAST 


+ 


SQUARES SOLUTION, ONE MUST COMPUTE V*W TIMES THE COLUMNS OF 


+ + 
B, WHERE W IS A DIAGONAL MATRIX, W (I)=@ IF W(I) IS 
NEGLIGIBLE, OTHERWISE IS 1/W(I). IF IRHS=@ OR M.LT.N, 
B IS NOT REFERENCED. 


IRHS IS THE NUMBER OF RIGHT-HAND-SIDES OF THE OVERDETERMINED 
SYSTEM A*X=B, IRHS SHOULD BE SET TO ZERO IF ONLY THE SINGULAR 


VALUE DECOMPOSITION OF A IS DESIRED. 


HYB 296 


HYB 360 
HYB 37¢ 
HYB 380 
HYB 39¢ 


HYB 994 
HYB 146¢¢ 
HYB 1616 
HYB 16206 
HYB 163¢6 
HYB 10646 
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aa 


aa 


AAARAAAAAAHA 


MATU SHOULD BE SET TO .TRUE. IF THE U MATRIX IN THE 
DECOMPOSITION IS DESIRED, AND TO .FALSE. OTHERWISE. 


MATV SHOULD BE SET TO .TRUE. IF THE V MATRIX IN THE 
DECOMPOSITION IS DESIRED, AND TO .FALSE. OTHERWISE, 


WHEN HYBSVD IS USED TO COMPUTE 'THE MINIMAL LENGTH LEAST 
SQUARES SOLUTION TO AN OVERDETERMINED SYSTEM, MATU SHOULD 
BE SET TO .FALSE. , AND MATV SHOULD BE SET TO .TRUE,. 


ON OUTPUT: 
A IS UNALTERED (UNLESS OVERWRITTEN BY U OR V). 


W CONTAINS THE (NON-NEGATIVE) SINGULAR VALUES OF A (THE 
DIAGONAL ELEMENTS OF W). THEY ARE SORTED IN DESCENDING 
ORDER. IF AN ERROR EXIT IS MADE, THE SINGULAR VALUES 
SHOULD BE CORRECT AND SORTED FOR INDICES IERR+1,...,MIN(M,N). 


U CONTAINS THE MATRIX U (ORTHOGONAL COLUMN VECTORS) OF THE 
DECOMPOSITION IF MATU HAS BEEN SET TO .TRUE. IF MATU IS 
FALSE, THEN U IS EITHER USED AS A TEMPORARY STORAGE (IF 
M .GE. N) OR NOT REFERENCED (IF M .LT. N). 

U MAY COINCIDE WITH A IN THE CALLING SEQUENCE. 
IF AN ERROR EXIT IS MADE, THE COLUMNS OF U CORRESPONDING 
TO INDICES OF CORRECT SINGULAR VALUES SHOULD BE CORRECT. 


V CONTAINS THE MATRIX V (ORTHOGONAL) OF THE DECOMPOSITION IF 
MATV HAS BEEN SET TO .TRUE. IF MATV IS 
FALSE, THEN V IS EITHER USED AS A TEMPORARY STORAGE (IF 
M .LT. N) OR NOT REFERENCED (IF M .GE. N). 
IF M .GE. N, V MAY ALSO COINCIDE WITH A. IF AN ERROR, 
EXIT IS MADE, THE COLUMNS OF V CORRESPONDING TO INDICES OF 
CORRECT SINGULAR VALUES SHOULD BE CORRECT. 


Z CONTAINS THE MATRIX X IN THE SINGULAR VALUE DECOMPOSITION 
T 
OF R=XSY, IF THE MODIFIED ALGORITHM IS USED. IF THE 
GOLUB-REINSCH PROCEDURE IS USED, THEN IT IS NOT REFERENCED. 
IF MATU HAS BEEN SET TO .FALSE. IN THE CASE M.GE.N (OR 
MATV SET TO .FALSE. IN THE CASE M.LT.N), THEN Z IS NOT 


REFERENCED AND NO EXTRA STORAGE IS REQUIRED. 
IERR IS SET TO 
ZERO FOR NORMAL RETURN, 
K IF THE K-TH SINGULAR VALUE HAS NOT BEEN 
DETERMINED AFTER 36 ITERATIONS. 
-1 IF IRHS .LT. @ . 
-2 IF M .LT. 1 .OR. N .LT. 1 
-3 IF NA .LT. M .OR. NU .LT. M .OR, NB .LT. M. 
-4 IF NV .LT. N. 
-5 IF NZ .LT. MIN(M,N). 


RV1 IS A TEMPORARY STORAGE. ARRAY OF LENGTH AT LEAST MIN(M,N). 


PROGRAMMED BY : TONY CHAN 
BOX 2158, YALE STATION, 
COMPUTER SCIENCE DEPT, YALE UNIV., 
NEW HAVEN, CT $6520. 

LAST MODIFIED : JANUARY, 1982. 


HYBSVD USES THE FOLLOWING FUNCTIONS AND SUBROUTINES. 
INTERNAL GRSVD, MGNSVD, SRELPR 
FORTRAN MIN@,ABS,SQRT, FLOAT, SIGN, AMAX1 
BLAS SSWAP 
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1650 
1060 
107¢ 
1080 
1996 
1166 
11106 
112¢ 
113@ 
1146 
115¢ 
116¢ 
1170 
118¢ 
119¢ 
126¢ 
121 
1220 
123¢ 
1240 
125@ 
1260 
1270 
128¢ 
129¢ 
1306 
131¢ 
1320 
1330 
1340 
135@ 
1360 
1370 
1380 
1390 
1400 
141¢ 
142¢ 
143¢ 
1446 
145¢ 
1466 
147¢ 
148¢ 
1496 
1500 
1510 
1520 
1530 
1540 
1550 
1560 
1570 
1580 
159¢ 
1666 
1616 
162¢ 
1630 
164@ 
1650 
1660 
1670 
168 
1699 
17060 
1710 
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ALGORITHM 582 

The Gibbs—Poole-—Stockmeyer and Gibbs- 
King Algorithms for Reordering Sparse 
Matrices 


JOHN G. LEWIS 
Boeing Computer Services Co. 


Categories and Subject Descriptors: G.1.3 [Numerical Analysis]: Numerical Linear Algebra—sparse 
and very large systems; G.m [Mathematics of Computing]: Miscellaneous—FORTRAN 


General Terms: Algorithms 


Additional Key Words and Phrases: Matrix bandwidth, matrix profile, matrix wavefront, banded 
matrix, Gibbs—Poole-Stockmeyer algorithm, Gibbs-King algorithm 


DESCRIPTION 


Given the structure of a symmetric or structurally symmetric sparse matrix, 
GPSKCA attempts to find a symmetric reordering of the matrix that produces a 
smaller bandwidth or profile. References [1], [4], [5], and [6] explain in detail the 
algorithms realized by GPSKCA. This algorithm provides the same mathematical 
capabilities as provided by REDUCE, Algorithms 508, and 509, but requires less 
memory and time and removes some implicit restrictions on the matrices that 
can be reordered. A description of the differences in the implementation and their 
effects is given in [7]; GPSKCA and REDUCE produce the same bandwidth and 
profile on all problems for which REDUCE executes successfully. 
The package of subroutines is evoked by the FORTRAN statement 


CALL GPSKCA (N, NZ, CONNEC, RSTART, DEGREE, OPTPRO, PERMUT, WORK, 
WRKLEN, ERROR, SPACE) 


where the parameters are described in the listing given here. The subroutines 
attempt‘to find a symmetric (row and column) permutation that reduces the 
bandwidth or profile of the reordered matrix. Whether to emphasize profile 
reduction or bandwidth reduction is determined by the logical parameter OPT- 
PRO. 

A common use for this algorithm will be prior to the solution of sparse linear 
algebraic equations or algebraic eigenvalue problems of moderately large size. 
The algorithm is supplied together with a FORTRAN program that accepts a 
sparse symmetric matrix in a standard sparse format and produces the equivalent 
reordered matrix in a format suitable for solving linear algebraic equations with 
the banded solvers in LINPACK [2] or the envelope solver in SPARSPAK [3]. 

The algorithm has been written in 1966 American National Standard FOR- 
TRAN. The package consists of 17 subroutines, GPSKCA, GPSKCB, ..., 
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GPSKCQ. Special comment cards have been included so that the user can easily 
convert the code to an IBM FORTRAN version that uses half-length integers 
(INTEGER « 2) for all of the arrays except RSTART. This reduces the memory 
requirements by nearly a factor of 2 at the cost of restricting the order of the 
matrix to 32,767 or smaller. There would be no immediate restriction on the 
number of nonzeros in the matrix. 

The primary difference in the usage of GPSKCA and its predecessor, REDUCE, 
is in the representation of the structure of the matrix. The format used herein is 
often much more efficient in space than that used in REDUCE. For the conven- 
ience of those users of REDUCE who would like to obtain the faster execution 
speeds of GPSKCA, but who cannot conveniently convert to the new, compact, 
format, an alternative version, GPSKRA, which accepts the older format for the 
matrix, will be supplied by the author upon request (not by the ACM distribution 
service). 
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ALGORITHM 
[A part of the listing is printed here. The complete listing is available from the 


C === SEPARATOR === BEGINNING OF GPS AND GK ALGORITHMS 

SUBROUTINE GPSKCA (N, DEGREE, RSTART, CONNEC, OPTPRO, WRKLEN, GPSKCA 1 
1 PERMUT, WORK, BANDWD, PROFIL, ERROR, SPACE)GPSKCA 2 
GPSKCA 3 

SRSSS SSS SSS SS SSs Saas SSS SSeS SSSA SS 6ST SH Sa Tae Sass SH Bass sesssszemeGPSKCA 4 
SSS SSS SSS SsSs SSS See sess sees SSS SSS SSeS TSS SST Sass SSS sss ss esses GPSKCA 5 
= =GPSKCA 6 
=BANDWIODTH OR PROFILE REDUCTION #=GPSKCA 7 
= FOR A SPARSE AND (STRUCTURALLY) SYMMETRIC MATRIX, =GPSKCA 8 
= USING EITHER =GPSKCA 9 
= =GPSKCA1@ 
= THE GIBBS-POOLE-STOCKMEYER ALGORITHM (BANDWIDTH REDUCTION) =GPSKCAI1 


CIBM 


OR =GPSKCA12 
THE GIBBS-KING ALGORITHM (PROFILE REDUCTION) =GPSKCA13 
=GPSKCA14 


SESS t SASS SSE SSS ese SSA SRS SSeS Sass Se sees ears seeABESBsse===(GPSKCALS 


SSS SSS eS Sees SSeS A ESE SESS SESS see ees ess===GPSKCALS 


= THIS CODE SUPERSEDES TOMS ALGORITHMS 598 AND 509 IN THE =GPSKCA17 
7 COLLECTED ALGORITHMS OF THE ACM (CALGO). =GPSKCA18 
SEBS PSPS LSS ESS SAS SSS SSSR SSS SCCSeSE SSS eases sess s==HGPSKCALI 
SSSSS SSeS SSS eee ee EE eA SAS ees Eee ees s===GPSKCA2¢G 
GPSKCA21 

Se GPSKCA22 
PARAMETERS GPSKCA23 
So eee et eee eer ene GPSKCA24 
GPSKCA25 

INTEGER N, RSTART(N), WRKLEN, BANDWD, PROFIL, ERROR, SPACE GPSKCA26 
i: GPSKCA27 

INTEGER *2 DEGREE(N), CONNEC(1), PERMUT(N), WORK(WRKLEuw, GPSKCA28 
INTEGER DEGREE(N), CONNEC(1), PERMUT(N), WORK(WRKLEN) GPSKCA29 
GPSKCA3@ 
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LOGICAL 


fag eget ayes ey Pena eens cot nicer en, para gen ea ne Rae ON Ira eng CaO GeASe Aruna gprgadenr aay Ganeg> Garnet wearing. oy ea senrea Wg ea Ga: ry named 09: woscaten aural ge Wa el O2 en aces ea eae) 


N —— 


DEGREE, 
RSTART, 
CONNEC -- 


OPTPRO -- 


WRKLEN -- 


PERMUT -- 


WORK -- 


_ OPTPRO 


INPUT PARAMETERS: 


THE DIMENSION OF THE MATRIX 


DESCRIBE THE STRUCTURE OF THE SPARSE MATRIX. 
DEGREE(I) SPECIFIES THE NUMBER OF NON-ZERO 
OFF-DIAGONAL ENTRIES IN THE I-TH ROW OF THE 
SPARSE MATRIX.’ THE COLUMN INDICES OF THESE 
ENTRIES ARE GIVEN IN CONSECUTIVE LOCATIONS IN 
CONNEC, STARTING AT LOCATION RSTART(I). 
IN OTHER WORDS, THE INDICES OF THE NON-ZERO 
OFF-DIAGONAL ELEMENTS OF THE I-TH ROW ARE FOUND 
IN: 

CONNEC (RSTART(I)), 

CONNEC (RSTART(I) + 1), 


CONNEC (RSTART(I) + DEGREE(I) - 1) 


DIMENSIONS: 
RSTART IS DIMENSION N_ (OR LONGER). 
DEGREE IS DIMENSION N (OR LONGER). 
CONNEC IS DLMENSION ROUGHLY THE WUMBER OF NON- 
ZERO ENTRIES IN THE MATRIX. 


-TRUE. IF REDUCING THE PROFILE OF THE MATRIX 
IS MORE IMPORTANT THAN REDUCING THE 
BANDWIDTH 

-FALSE. IF BANDWIDTH REDUCTION IS MOST IMPORTANT 
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GPSKCA31 
GPSKCA32 
GPSKCA33 
GPSKCA34 
GPSKCA35 
GPSKCA36 
GPSKCA37 
GPSKCA38 
GPSKCA39 
GPSKCA4@ 
GPSKCA41 
GPSKCA42 
GPSKCA43 
GPSKCA44 
GPSKCA45 
GPSKCA46 
GPSKCA47 
GPSKCA48 
GPSKCA49 
GPSKCA5@ 
GPSKCAS1 
GPSKCA52 
GPSKCA53 
GPSKCA5S4 
GPSKCA55 
GPSKCA56 
GPSKCA57 
GPSKCA58 
GPSKCA59 
GPSKCA6@ 
GPSKCA61 
GPSKCA62 
GPSKCA63 
GPSKCA64 
GPSKCA65 
GPSKCA66 


THE ACTUAL LENGTH OF THE VECTOR WORK AS SUPPLIEDGPSKCA67 


BY THE USER. SEE THE DISCUSSION OF THE WORKSPACE 
"WORK' BELOW FOR TYPICAL STORAGE REQUIREMENTS. 
THE VALUE OF WRKLEN WILL BE USED TO ENSURE THAT 
THE ROUTINE WILL NOT USE MORE STORAGE THAN IS 
AVAILABLE. IF NOT ENOUGH SPACE IS GIVEN IN WORK 
TO PERMIT A SOLUTION TO BE FOUND, THE ERROR FLAG 
WILL BE SET AND FURTHER COMPUTATION STOPPED. 


INPUT AND OUTPUT PARAMETER: 


ON INPUT, AN ALTERNATIVE REORDERING FOR THE 

ROWS AND COLUMNS OF THE MATRIX. PERMUT(I) GIVES 
THE POSITION IN WHICH ROW AND COLUMN I SHOULD 

BE PLACED TO REDUCE THE BANDWIDTH OR THE PROFILE. 
IF THE USER HAS NO ALTERNATIVE TO THE NATURAL 
ORDERING IMPLICIT IN DEGREE, RSTART AND CONNEC, 
HE SHOULD INITIALIZE PERMUT TO BE THE IDENTITY 
PERMUTATION PERMUT(I) =I. 


ON OUTPUT, PERMUT WILL CONTAIN THE PERMUTATION 
FOR REORDERING THE ROWS AND COLUMNS WHICH REDUCES 
THE BANDWIDTH AND/OR PROFILE. THE RESULT WILL BE 
THE REORDERING FOUND BY 'GPSKCA' OR THE REORDERING 
GIVEN BY THE USER IN 'PERMUT', WHICHEVER DOES THE 
JOB BETTER. 


OUTPUT PARAMETERS: 


A TEMPORARY STORAGE VECTOR, OF LENGTH SOMEWHAT 
GREATER THAN 3N. THE SPACE BEYOND 3N REQUIRED 
IS PROBLEM-DEPENDENT. ANY PROBLEM CAN BE SOLVED 
IN 6N+3 LOCATIONS. 


GPSKCA68 
GPSKCA69 
GPSKCA70@ 
GPSKCA71 
GPSKCA7 2 
GPSKCA73 
GPSKCA74 
GPSKCA75 
GPSKCA76 
GPSKCA77 
GPSKCA78 
GPSKCA79 
GPSKCA8@ 
GPSKCA81 
GPSKCA82 
GPSKCA83 
GPSKCA84 
GPSKCA85 
GPSKCA86 
GPSKCA87 
GPSKCA88 
GPSKCA89 
GPSKCA9@ 
GPSKCA91 
GPSKCA92 
GPSKCA93 
GPSKCA94 
GPSKCA95 
GPSKCA96 
GPSKCA97 
GPSKCA98 
GPSKCA99 
GPSKC100 
GPSKC101 
GPSKC162 
GPSKC143 


0 


COLLECTED ALGORITHMS (cont.) 


C 


AAAQAQAAAABANAAANRAAANAG 


Qa 


Pi 


MQANRANAAQANAANRQRANANQANQNQNANQNANAAAANAANQNAANQNQAANAANAAAANAaAARANANS 


ERROR 


wee 


MOST PROBLEMS CAN BE REORDERED WITH 4N LOCATIONS 
IN 'WORK'. IF SPACE IS NOT A CONSTRAINT, PROVIDE 
6N+3 LOCATIONS IN 'WORK'. OTHERWISE, PROVIDE AS 
MUCH MORE THAN 3N AS IS CONVENIENT AND. CHECK .THE 
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GPSKC104 
GPSKC105 
GPSKC106 
GPSKC107 


ERROR FLAG AND SPACE REQUIRED PARAMETERS (SEE BELOW) GPSKC108 


ON OUTPUT, THE 1ST N LOCATIONS OF WORK WILL BE 

A LISTING OF THE ORIGINAL ROW AND COLUMN INDICES AS 
THEY APPEAR IN THE COMPUTED REORDERING. 

LOCATIONS N+l, .-- , 2N OF WORK WILL CONTAIN 
THE NEW POSITIONS FOR THE EQUATIONS IN THE ORDER 
FOUND BY GPSKCA. THUS, THE TWQ) VECTORS ARE INVERSE 
PERMUTATIONS OF EACH OTHER. IF THE ORDERING © 

FOUND BY THIS ALGORITHM IS BETTER THAN THE USER- 
SUPPLIED ORDER, THE SECOND PERMUTATION VECTOR IS 
IDENTICAL TO THE RESULT RETURNED IN: 'PERMUT'. 


BANDWD -- THE BANDWIDTH OF THE MATRIX WHEN ROWS AND COLUMNS 
ARE REORDERED IN THE ORDERING RETURNED IN PERMUT. 


PROFIL -- THE PROFILE OF THE MATRIX WHEN ROWS AND COLUMNS ARE 
REORDERED IN THE ORDERING RETURNED IN PERMUT. 


ERROR -~ WILL BE EQUAL TO ZERO IF A NEW NUMBERING COULD BE 
FOUND IN THE SPACE PROVIDED. OTHERWISE, ERROR 
WILL BE SET TO A POSITIVE ERROR CODE (SEE TABLE 
GIVEN BELOW). IF THE REORDERING ALGORITHM HAS BEEN 
STOPPED BY LACK OF WORKSPACE, THE SPACE PARAMETER 
WILL BE SET TO THE NUMBER OF ADDITIONAL LOCATIONS 
REQUIRED TO COMPLETE AT LEAST THE NEXT PHASE OF 
THE ALGORITHM. 


WHENEVER A NON-ZERO VALUE FOR ERROR IS GIVEN 
PERMUT WILL RETAIN THE VALUES PROVIDED BY THE USER 


GPSKC1@9 
GPSKC11@ 
GPSKC111 


‘GPSKC112 


GPSKC113 
GPSKC114 
GPSKC115 
GPSKC116 
GPSKC117 
GPSKC118 
GPSKC119 
GPSKC120 
GPSKC121 
GPSKC122 
GPSKC123 
GPSKC124 
GPSKC125 
GPSKC126 
GPSKC127 
GPSKC128 
GPSKC129 
GPSKC13@ 
GPSKC131 
GPSKC132 
GPSKC133 
GPSKC134 
GPSKC135 
GPSKC136 
GPSKC137 


AND THE SCALARS BANDWD AND PROFIL WILL BE SET TOGPSKC138 


OUTRAGEOUS VALUES. IT IS THE USER'S RESPONSIBILITY GPSKC139 

TO CHECK THE STATUS OF ERROR. GPSKC14@ 

GPSKC141 

SPACE --. WILL INDICATE EITHER HOW MUCH SPACE THE REORDERING GPSKC142 
ACTUALLY REQUIRED OR HOW MUCH SPACE WILL BE GPSKC143 

REQUIRED TO COMPLETE THE NEXT PHASE OF THE GPSKC144 
REORDERING ALGORITHM. THE POSSIBLE OUTCOMES ARE .. GPSKC145 

: GPSKC146 

ERROR = @ SPACE IS THE MINTMAL VALUE FORGPSKC147 

WRKLEN REQUIRED TO REORDER GPSKC148 

THIS MATRIX AGAIN. GPSKC149 

, GPSKC15@ 

ERROR FJ @ SPACE IS THE MINIMUM NUMBER — GPSKC151 

DUE TO LACK OF OF EXTRA WORKSPACE REQUIRED. GPSKC152 

WORKSPACE TO CONTINUE THE REORDERING GPSKC153 

ALGORITHM ON THIS MATRIX. GPSKC154 

GPSKC155 

ERROR FJ @ SPACE = -1 GPSKC156 

DUE TO ERROR GPSKC157 

IN DATA STRUCTURES GPSKC158 

GPSKC159 

GPSKC16@ 

SSSESaS SS Seeeeoee soe ee eee eee eee eens ee eee eee ee? SKC1 61 
 GPSKC162 
------+----=+----------- GPSKC163 
CODES GPSKC164 
----------------- +--+ ' GPSKC1L65 
GPSKC166 

ERROR CODES HAVE THE FORM @XY OR 1XY. GPSKC167 
: GPSKC168 

ERRORS OF THE FORM 1XY RESULT FROM INADEQUATE WORKSPACE. GPSKC169 
. GPSKC176 
ERRORS OF THE FORM @XY ARE INTERNAL PRCGRAM CHECKS, WHICH GPSKC171 
MOST LIKELY OCCUR BECAUSE THE CONNECTIVITY STRUCTURE OF THE GPSKC172 
MATRIX IS REPRESENTED INCORRECTLY (E.G., THE DEGREE OF GPSKCL73 
A NODE IS NOT CORRECT OR NODE I IS CONNECTED TO NODE J, GPSKC174 
BUT NOT CONVERSELY). GPSKC175 
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“ALGORITHM | 583 ae 
LSQR: Sparse Linear Equations and Least 
Squares Problems | 


CHRISTOPHER C. PAIGE 
McGill University, Canada 
and — . a 
MICHAEL A. SAUNDERS | 
Stanford University 


Categories and Subject Descriptors: G.1.3 [Numerical Analysis]: Numerical Linear Algebra—linear 
systems (direct and iterative methods); G.3 [Mathematics of Computing]: Probability and Statis- 
tics—statistical computing; statistical software: G.m [Mathematics of Computing]: Miscella- 
‘neous—FORTRAN program units 


General Terms: Algorithms 


Additional Key Words and Phrases: Asal of variance, conjugate- gradient method, least squares, 
linear equations, regression, sparse matrix 


1. INTRODUCTION | 
-LSQR finds a solution x to the following problems: 


Unsymmetric equations: solve Ax=b (1.1) 


Linear least squares: minimize || Ax — b|l2 (1.2) 


ae, 


where A is a matrix with m rows and n columns, 0 is an m-vector, A is a scalar, 
and the given data A, 8, Xd are real. The matrix A will normally be large and 
sparse. It is defined by means of a user-written subroutine APROD, whose 
essential function is to compute products of the form Ax and A‘y for given 
vectors x and y. 

Problems (1.1) and (1.2) are treated as special cases of (1.3), which we shall 
write as 


Damped least squares: minimize 


2 


on Zz = z A > |b 
min||Ax— bl, A= bel b= ra (1.4) 
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Table I. Comparison of CGLS and LSQR 


Storage Work per iteration 


CGLS, A = 0 2m + 2n 2m + 3n 


CGLS, \ #0 2m + 2n 2m + 5n 
LSQR, any A m+2n 3m + 5n 


An earlier successful method for such problems is the conjugate-gradient method 
for least squares systems given by Hestenes and Stiefel [3]. (This method is 
described as algorithm CGLS in [6, sect. 7.1].) CGLS and LSQR are iterative 
methods with similar qualitative properties. Their computational requirements 
are summarized in Table I. In addition they require a product Ax and a product 
A’y each iteration. 

in order to achieve the storage shown for LSQR, we ask the user to an ement 
the matrix-vector products in the form 


y<yt+Ax and x<—x+A'y, (1.5) 


where <- means that one of the given vectors is overwritten by the expression 
shown. (A parameter specifies which expression the user’s subroutine APROD 
should compute on any given entry.) We see that LSQR has a storage advantage 
if the operations (1.5) can be performed with no additional storage beyond that 
required to represent A. For least squares applications with many observations 
(m > n), this could be useful. 

The work shown in Table I is the number of floating-point multiplications per 
iteration, excluding the work involved in the products Ax, A’y. Since CGLS is 
somewhat more efficient, we would not discourage using that method whenever 
A or A is well conditioned. However, LSQR is likely to obtain a more accurate 
solution in fewer iterations if A is moderately or severely ill-conditioned. 

Let 7 = 6 — Ax; be the residual vector associated with the kth iteration. LSQR 
provides estimates of || xz |l2, || 7% lz, || A’ 7 |l2, the norm of A, the condition number 
of A, and standard errors for the components of x. The last two items require a 
further 2n multiplications per iteration and an additional n-vector of storage. 

Subroutine LSQR is written in the PFORT subset of American National 
Standard FORTRAN. It contains no machine-dependent constants. Auxiliary 
routines required are APROD, NORMLZ, SCOPY, SNRM2, and SSCAL. The 
last three correspond to members of the BLAS collection [5]. 


2. MATHEMATICAL BACKGROUND 


Algorithmic details are given in [6], mainly for the case A = 0. We summarize 
these here with \ reintroduced, and show that a given value of . may be dealt 
with at nevlisible cost. The vector norm || v||2 = (v'v)'” is used throughout. 

LSQR uses an algorithm of Golub and Kahan to reduce A to lower bidiagonal 
form. The quantities produced from A and 6 after k + 1 steps of the bidiagonal- 
ization (procedure Bidiag 1 [6]) are 


Qa) 
Bi = [0], B, oe 
Urea = [Was las vey Mart ee z . (21) 
Vivi = [U1, Ve, ..., Uesil, Pa 
Brest 


The kth approximation to the solution x is then defined to be x, = Viz, where 


yr solves the subproblem 
. Bp = Bier 
min E "| Yk | 0 | 


(2.2) 
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Letting the associated residual vectors be 


thoi = Bie: — Bryrx 
rr = 5b- AXk (2.3) 


Tr = 5 — Axr, 
we find that the relations 


rr = Unsiteri (2.4) 


T 
A™rp = N?x~ + OnsiTRHVE+1 


will hold to machine accuracy, where 74+: is the last component of t,11, and we 
therefore conclude that (r;, xz) will be an acceptable solution of (1.4) if the 
computed value of either || ¢+1|| or | @e+174+1| is suitably small. 

Bjorck [1] has previously observed that subproblem (2.2) is the appropriate 
generalization of min|| Bzy. — Bie: ||, when A # 0. He also discusses methods for 
computing y, and «x, efficiently for various A and k. 

In LSQR we assume that a single value of X is given, and to save storage and 
work, we do not compute yz, 7, or t+1. The orthogonal factorization 


Ri fe 
Ke = 0 am (2.5) 
O Qk 


is computed (Q2Q, = I; R, upper bidiagonal, k x k) and this would give Rive = 
fz, but instead we solve Ri Df = Vi and form x, = Drfz.. 

The factorization (2.5) is formed similarly to the case \ = 0 in [6], except that 
two rotations are required ver step instead of one. For k = 2, the factorization 
proceeds accordiny to 


a Bi pi di Pi O2 1 
Be a2 Be a2 p2 obo 
Bs > Bs > Bs 
A Wy Wy 
A A A 
pi A Pr: 8 di 
bo oe p2 de 
— Bs - 3 

Yi Yi 
pe Yo 


Note that the first \ is rotated into the diagonal element a,. This alters the right- 

hand side fe: to produce ,, the first'icomponent of g,. An alternative is to rotate 

A into B2 (and similarly for later X), since this does not affect the right-hand side 

and it more closely simulates the algorithm that results when LSQR is applied to 

A and 6 directly. However, the rotations then have a greater effect on B;, and in 

practice the first option has proved to give marginally more accurate results. 
The estimates required to implement the stopping criteria are 


[| Fe? = [rel + A? xa ll? = Shor + Uaell®, 
_ a 
Aral] = |Atre — A’xe || = sees 
k 


This is a simple generalization of the case A = 0. No additional storage is needed 
for gz, since only its norm is required. In short, although the presence of A 
complicates the algorithm description, it adds essentially nothing to the storage 
and work per iteration. 
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3. REGULARIZATION AND RELATED WORK 


Introducing A) as in (1.3) is just one way of “regularizing” the solution x, in the 
sense that it can reduce the size of the computed solution and make its compo- 
nents less sensitive to changes in the data. LSQR is applicable when a value of 
\ is known a priori. The value is entered via the subroutine parameter DAMP. A 
second method for regularizing x is available through LSQR’s parameter ACOND, 
which can cause iterations to terminate before || x; || becomes large. A similar 
approach has recently been described by Wold et al. [9], who give an illuminating 
interpretation of the bidiagonalization as a partial least squares procedure. Their 
description will also be useful to those who prefer the notation of multiple 
regression. 

Methods for choosing A, and other approaches to regularization, are given in 
[1, 2, 4, 8] and elsewhere. For a philosophical discussion, see [7]. 


4. CODING APROD 


The best way to compute y + Ax and x + A'y depends upon the origin of the 
matrix A. We shall illustrate a case that commonly arises, in which A is a sparse 
matrix whose nonzero coefficients are stored by rows in a simple list. Let A have 
M rows, N columns, and NZ nonzeros. Conceptually we need three arrays 
dimensioned as REAL RA(NZ) and INTEGER JA(NZ), NA(M),.where 


RA(L) is the Lth nonzero of A, counting across row 1, then across row 2, and 
sO On; 

JA(L) is the column in which the Lth nonzero of A lies; 

NA(I)_ is the number of nonzero coefficients in the [th row of A. 


These quantities may be used in a straightforward way, as shown in Figure 1 (a 
FORTRAN implementation). We assume that they are made available to 
APROD through COMMON, and that the actual array dimensions are suitably 
large. 

Blank or labeled COMMON will often be convenient for transmitting data to 
APROD. (Of course, some of the data could be local to APROD.) For greater 
generality, the parameter lists for LSQR and APROD include two workspace 
arrays IW, RW and their lengths LENIW, LENRW. LSQR does not use these 
parameters directly; it just passes them to APROD. 

Figure 2 illustrates their use on the same example (sparse A stored by rows). 
An auxiliary subroutine APROD1 is needed to make the code readable. A similar 
scheme should be used to initialize the workspace parameters prior to calling 
LSQR. 

Returning to the example itself, it may often be natural to store A by columns 
rather than rows, using analogous data structures. However, we note that in 
sparse least squares applications, A may have many more rows than columns 
(M > N). In such cases it is vital to store A by rows as shown, if the machine 
being used has a paged (virtual) memory. Random access is then restricted to 
arrays of length N rather than M, and page faults will therefore be kept to a 
minimum. 

Note also that the arrays RA, JA, NA are adequate for computing both Ax and 
A‘y; we do not need to store A by rows and by columns. 

Regardless of the application, it will be apparent when coding APROD for the 
two values of MODE that the matrix A is effectively being defined twice. Great 
care must be taken to avoid coding inconsistent expressions y + Aix and x + 
Az y, where either A; or Ag is different from the desired A. (If A: ¥ Ae, algorithm 
LSQR will not converge.) Parameters ANORM, ACOND, and CONLIM provide 
a safeguard for such an event. 


5. PRECONDITIONING 


It is well known that conjugate-gradient methods can be accelerated if a nonsin- 
gular matrix M is available to approximate A in some useful sense. When A is 
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square and nonsingular, the system Ax = b is equivalent to both of the following 


systems: 
(M—'A)x =c where Mc = 5; (5.1) 
(AM")z=b where Mx = z. (5.2) 
For least squares systems (undamped), only the analogue of (5.2) is applicable: 
min|| Ax — b||2 = min||(AM~')z — b|j2, where Mx =z. (5.3) 
SUBROUTINE APROD( MODE ,M,N,X,¥, 
4 * LENIW, LENRW,IW,RW ) 


INTEGER MODE ,M,N, LENIW, LENRW 
INTEGER IW(LENIW) 


REAL X(N), Y(M) , RWC LENRW) 
C 
C APROD PERFORMS THE FOLLOWING FUNCTIONS: 
Cc 
Cc IF MODE = 1, SET Y = Y + A*X 
Cc IF MODE = 2, SET X = X + A(TRANSPOSE)*Y 
Cc 
Cc WHERE A IS A MATRIX STORED BY ROWS IN 
Cc THE ARRAYS RA, JA, NA. IN THIS EXAMPLE, 
C RA, JA, NA ARE STORED IN COMMON. 
Cc 
REAL RA 
INTEGER JA,NA 
COMMON RA( 9000) , JA( 9000) , NAC 1000) 
Cc 
C INTEGER I,J,L,L1,L2 
REAL SUM, YI, ZERO 
C 
ZERO = 0.0 
L2 =0 
IF (MODE .NE.1) GO TO 400 
Fig. 1. Computation of y + Ax, C 
x + ATy, where A is a sparse CC ate ene + 5 
matrix stored compactly by Cc MODE = 1 -- SET Y = Y + A*X. 
rows. For convenience, the CO ee tt nee ie mami 
data structure for A is held in DO 200 T= 1, M 
COMMON. SUM = ZERO 
Ll = 12+ 1 


L2 = L2 + NA(I) 
: DO 100 L = Ll, L2 
J = JA(L) 
SUM = SUM + RA(L)*X(J) 
100 CONTINUE 
Y(I) = Y(I) + SUM 
200 CONTINUE 
RETURN 


MODE = 2 ~— SET xX = X + A(TRANSPOSE)*Y. 
400 DO 600 I= 1, M 
YI = Y(I) 
Ll = L2 + 1 
L2 = L2 + NA(I) 
DO 500 L = Ll, L2 
oa = JA(L) 
X(J) = X(J) + RACL)*YI 
500 CONTINUE . 
600 CONTINUE 
‘ RETURN 


aaAaANaQ 


C END OF APROD 
END 
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ao 


* 


lone) 


* 


aa 


LEAST-SQUARES 


CONDITION NO. 


Fig. 3. Example output from test program and LSQR on a damped least squares problem. - 
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SUBROUTINE APROD( MODE,M,N,X,Y, 
LENIW,LENRW,IW,RW ) 


INTEGER MODE,M,N, LENIW, LENRW 

INTEGER IW(LENIW) 

REAL X(N), Y(M) , RWC LENRW) 

APROD PERFORMS THE FOLLOWING FUNCTIONS: 


IF MODE 
IF MODE 


1, SET Y 
2, SET xX 


Y + A*X 
X + ACTRANSPOSE)*Y 


WHERE A IS A MATRIX STORED BY ROWS IN 
THE ARRAYS RA, JA, NA. IN THIS EXAMPLE, 
APROD IS AN INTERFACE BETWEEN LSQR AND 
ANOTHER USER ROUTINE THAT DOES THE WORK. 
THE WORKSPACE ARRAY RW CONTAINS RA. 

THE FIRST M COMPONENTS OF IW CONTAIN NA, 
AND THE REMAINDER OF IW CONTAINS JA. 

THE DIMENSIONS OF RW AND IW ARE ASSUMED 
TO BE SUFFICIENTLY LARGE. 


INTEGER LENJA, LENRA, LOCJA 


LOCJA =M+1 
LENJA = LENIW - LOCJA + 1 
LENRA = LENRW 


CALL APROD1( MODE,M,N,X,Y, 
LENJA, LENRA, IW, IW(LOCJA) ,RW ) 
RETURN 


END OF APROD 
END 


SUBROUTINE APROD1( MODE,M,N,X,Y, 
LENJA,LENRA,NA,JA,RA ) 


INTEGER MODE,M,N, LENJA, LENRA 

INTEGER NA(M) , JACLENJA) 

REAL X(N), Y(M) , RACLENRA) 

APROD1 DOES THE WORK FOR APROD. 

INTEGER I,J,L,L1,L2 

REAL SUM, YI, ZERO 

< the same code as in APROD in Figure 1 > 


END OF APROD1 


Fig.2. Same as Figure 1, with 
the data structure for A held 
in the workspace parameters. 


END 

TEST PROBLEM P¢ 20 10 1 1 1.00E-03 ) 

= 9.9995E 00 RESIDUAL FUNCTION = 9.812157000E-01 
LSQR --  LEAST-SQUARES SOLUTION OF A*X = B 
THE MATRIX A_ HAS 20 ROWS AND 10 COLS 
THE DAMPING PARAMETER IS DAMP = = 1.00E--03 
ATOL = = 1.00E-06 CONLIM = 1.00E 02 
BTOL = 1.00E-06 ITNLIM = 80 
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ITN X(1) FUNCTION COMPATIBLE INCOMPATIBLE NORM(ABAR) COND(ABAR) 
0  0.0000000000E-01 6.3410580000E 00 1.000E 00 9.135E~02 

1  -6.3564250000E-01 4.0387670000E 00 6-369E-01 7.244E-01 7.51E-01  1.00E 00 

2 -4.7282630000E-01  2.3303970000E 00 3.675E-01  3.349E-O1 1.10E 00 2.42E 00 

3. -2.8075080000E-01  1.8962160000E 00 2.990E-01 2.462E-01 1.30E 00 3.63E 00 

4 2.6825070000E-01 1.5905200000E 00 2.508E-01 1.424E-01 1.49E 00 5.27E 00 

5  142649560000E 00 1.4032960000E 00 2.213E-01 1.160E-01 1.59E 00 7.09E 00 

6 2.0648040000E 00 1.2910880000E 00 2.036E-01 9.273E-02 1.70E 00 9.03E 00 

7 3.0031450000E 00 1.2072930000E 00 1.904E-01 8.294E-02 1.79E 00 1.12E 01 

8  3.7526340000E 00 1.1551220000E 00 1.822E-01 5.138E-02 1.90E 00 1.34E Ol 

9  5.4443550000E 00 1.0780640000E 00 1.700E-01 3.155E-02 1.95E 00 1.72E 01 
10  8.9918140000E 00 9.8151740000E-01 1.548E-01 1.283E-02 1.96E 00 2.44E O1 
11 8.9998990000E 00 9.8120520000E-01  1.547E-01  2.017E-04 2.20E 00 2.75E 01 
12. 8.9999290000E 0M 9.8120540000E-0!  1.547E-01 4.361E-06 2.38E 00 2.98E 01 
13. 8.9999280000F 00 9.8120550000E-01 1.547E-01 9.078E-07 2.48E 00 3.13E 01 

NO. OF ITERATIONS = 13 STOPPING CONDITION = 2 


THE LEAST-SQRS SOLN IS GOOD ENOUGH, GIVEN ATOL 


RESIDUAL NORM (ABAR*X - BBAR) 


RESIDUAL NORM (NORMAL EQNS) 


SOLUTION NORM (X) 


ESTIMATED BY LSQR 
COMPUTED FROM X 


9.812055E-01 
9.812157E-01 


2. 206693E-06 
1.083419E-05 


1.688187E 01 
1.688184E 01 


SOLUTION 

1 8.99993 2 7.99997 3. 6.99998 4 5.99999 5 4.99999 

6 3.99999 7 3.00000 8 2.00000 9 0.999994 10 -0.204206E-05 
STANDARD ERRORS 

1 2.11589 2 0.888101 3 0.685644 4 0.556184 5 0.614104 

6 0.409182 7 0.565480 8 0.519385 9 0.375466 10 0.589787 


Figure 3 (continued) 


We note only that subroutine LSQR may be applied without change to systems 
(5.1)-(5.3). The effect of M is localized to the user’s own subroutine APROD. For 
example, when MODE = 1, APROD for the last two systems should compute 
y + (AM“)x by first solving Mw = x and then computing y + Aw. Clearly it must 
be possible to solve systems involving M and M™ very efficiently. 


6. OUTPUT 


Subroutine LSQR produces printed output on file NOUT, if the parameter 
NOUT is positive. This is illustrated in Figure 3, in which the least squares 
problem solved is P(20, 10, 1, 1) as defined in [6], with a slight generalization to 
include a damping parameter A = 10°°*. (Single precision was used on an IBM 
370/168.) The items printed,at the kth iteration are as follows. 


ITN The iteration number k. Results are always printed for the 
first 10 and last 10 iterations. Intermediate results are 
printed if m < 40 or n < 40, or if one of the convergence 
conditions is nearly satisfied. Otherwise, information is 
printed every 10th iteration. 

The value of the first element of the approximate solution 
XR. 

The value of the function being minimized, namely || 7»|| = 
(| rx]? + A? I xe lV. : 

A dimensionless quantity which should converge to zero if 
and only if Ax =.b is compatible. It is an estimate of || 7% ||/ 
|| & ||, which decreases monotonically. 


X(1) 
FUNCTION 


COMPATIBLE 


0 


COLLECTED ALGORITHMS (cont.) 
INCOMPATIBLE A dimensionless quantity which should converge to zero if 


and only if the optimum ||7;|| is nonzero. It is an estimate 
of || ATF || /(|| A lll] 7% ||), which is usually not monotonic. 


NORM(ABAR) A monotonically increasing estimate of || A ||. 7 
COND(ABAR) A monotonically increasing estimate of cond(A) = 


\| A ||r|| A* |r, the condition number of A. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service’. 


ANMQANAAANAANNANAANAANnNAAN 


SUBROUTINE LSQR( M,N, APROD, DAMP, dg 
1 LENIW, LENRW, IW, RW, 26 
2 U,V,W,X,SE, 3. 
3 ATOL, BTOL, CONLIM, ITNLIM, NOUT, 4, 
4 ISTOP, ANORM, ACOND, RNORM, ARNORM, XNORM ) 5. 

6. 

EXTERNAL  APROD 7. 

INTEGER M,N, LENIW, LENRW, ITNLIM, NOUT, ISTOF 8. 

INTEGER IW(LENIW) 9. 

REAL RW(LENRW), U(M), V(N) ,W(N), X(N), SE(N), 1¢. 
1 ATOL, BTOL, CONLIM, DAMP, ANORM, ACOND, RNORM, ARNORM, XNORM i Es ee 

en ne ee ee ee ee ee ae ee ee ee Se Se eS ee ee ie 12. 

13. 

LSQR FINDS A SOLUTION X TO THE FOLLOWING PROBLEMS... 14. 

13. 

1. UNSYMMETRIC EQUATIONS -- SOLVE A*X = B 16. 
, 17. 

2. LINEAR LEAST SQUARES -- SOLVE A*X = B 18. 
IN THE LEAST--SQUARES SENSE 19. 

20. 

3. DAMPED LEAST SQUARES -- SOLVE ( A y*X = ( B ) 21. 
( DAMP*I ) (0) 22% 

IN THE LEAST--SQUARES SENSE 23. 

24. 

WHERE A IS A MATRIX WITH M ROWS AND N COLUMNS, B IS AN 25. 
M-VECTOR, AND DAMP IS A SCALAR (ALL QUANTITIES REAL). 26. 


THE MATRIX A IS INTENDED TO BE LARGE AND SPARSE. IT IS ACCESSED 27. 
BY MEANS OF SUBROUTINE CALLS OF THE FORM 28. 
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; 29. 

CALL APROD( MODE,M,N,X,Y,LENIW, LENRW, IW,RW ) 30. 

: 31. 

WHICH MUST PERFORM THE FOLLOWING FUNCTIONS... 32. 
33. 

IF MODE = 1, COMPUTE Y = Y + A*X. 34. 

IF MODE = 2, COMPUTE X = X + A(TRANSPOSE)#Y. 35. 

36. 

THE VECTORS X AND Y ARE INPUT PARAMETERS IN BOTH CASES. 37. 
IF MODE = 1, Y SHOULD BE ALTERED WITHOUT CHANGING X. 38. 
IF MODE = 2, X SHOULD BE ALTERED WITHOUT CHANGING Y. 39. 
THE PARAMETERS LENIW, LENRW, IW, RW MAY BE USED FOR WORKSPACE 40. 
AS DESCRIBED BELOW. a 
THE RHS VECTOR B IS INPUT VIA U, AND SUBSEQUENTLY OVERWRITTEN. 
4. 

e¢ . 45. 

NOTE. LSQR USES AN ITERATIVE METHOD TO APPROXIMATE THE SOLUTION. 46. 
THE NUMBER OF ITERATIONS REQUIRED TO REACH A CERTAIN ACCURACY 47. 
DEPENDS STRONGLY ON THE SCALING OF THE PROBLEM. POOR SCALING OF 48. 
THE ROWS OR COLUMNS OF A SHOULD THEREFORE BE AVOIDED WHERE 49. 
POSSIBLE. 5¢. 
. Siz 

FOR EXAMPLE, IN PROBLEM 1 THE SOLUTION IS UNALTERED BY 52. 
ROW-SCALING. IF A ROW OF A: IS VERY SMALL OR LARGE COMPARED TO 53. 
THE OTHER ROWS OF A, THE CORRESPONDING ROW OF (A B) SHOULD 54. 
BE SCALED UP OR DOWN. 55. 
. 56. 

IN PROBLEMS 1 AND 2, THE SOLUTION X IS EASILY RECOVERED Ss 
FOLLOWING COLUMN-SCALING. IN THE ABSENCE OF BETTER INFORMATION, 58. 
THE NONZERO COLUMNS OF A SHOULD BE SCALED SO THAT THEY ALL HAVE. 59. 
THE SAME EUCLIDEAN NORM (E.G. 1.0). 60. 
; 61. 

IN PROBLEM 3, THERE IS NO FREEDOM TO RE-SCALE IF DAMP IS 62. 
NONZERO. HOWEVER, THE VALUE OF DAMP SHOULD BE ASSIGNED ONLY 63. 
AFTER ATTENTION HAS BEEN PAID TO THE SCALING OF A. 64. 
65. 

THE PARAMETER DAMP IS INTENDED TO HELP REGULARIZE 66. 
ILL-CONDITIONED SYSTEMS, BY PREVENTING THE TRUE SOLUTION FROM 67. 
BEING VERY LARGE. ANOTHER AID TO REGULARIZATION IS PROVIDED BY 68. 
THE PARAMETER ACOND, WHICH MAY BE USED TO TERMINATE ITERATIONS 69. 
BEFORE THE COMPUTED SOLUTION BECOMES VERY LARGE. | 70. 
rhe 

72s 

NOTATION 73. 
~H--~--- Ta 
. — 75. 

THE FOLLOWING QUANTITIES ARE USED IN DISCUSSING THE SUBROUTINE 76. 
PARAMETERS... 77. 
78. 

ABAR = ( ) BBAR = (8B ). 79. 
( DAMP*I ) (@) ; 80. 

= . 81. 

R = B - AX, RBAR = BBAR - ABAR*X 82. 
83. 

RNORM = SQRT( NORM(R)**2 + DAMP#A2 * NORM(X) *#2 ) 84. 
= NORM( RBAR ) 85. 

86. 

RELPR = THE RELATIVE PRECISION OF FLOATING-POINT ARITHMETIC 87. 


ON THE MACHINE BEING USED. FOR EXAMPLE, ON THE IBM 370, 88. 
RELPR IS ABOUT 1.@£-6 AND 1.@D-16 IN SINGLE AND DOUBLE 89. 
PRECISION RESPECTIVELY. 99. 


LSQR MINIMIZES THE FUNCTION RNORM WITH RESPECT TO X. 92. 


M INPUT 


N INPUT 


“THE NUMBER:OF ROWS. IN” A. 98, 


THE NUMBER OF COLUMNS IN A. 100. 
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APROD EXTERNAL SEE ABOVE. 
DAMP INPUT THE DAMPING PARAMETER FOR PROBLEM 3 ABOVE. 
(DAMP SHOULD BF 0.@ FOR PROBLEMS 1 AND 2.) 
IF THE SYSTEM A*X = B IS INCOMPALIBLE, VALUES 
OF DAMP IN THE RANGE @ TO SQRT(RELPR) *NORM(A) 
WILL PROBABLY HAVE A NEGLIGIBLE EFFECT. 
LARGER VALUES OF DAMP WILL TEND TO DECREASE 
THE NORM OF X AND TO REDUCE THE NUMBER OF 
ITERATIONS REQUIRED BY LSQR. 
THE WORK PER ITERATION AND THE STORAGE NEEDED 
BY LSQR ARE THE SAME FOR ALL VALUES OF DAMP. 
LENIW INPUT THE LENGTH OF THE WORKSPACE ARRAY IW. 
LENRW INPUT THE LENGTH OF THE WORKSPACE ARRAY RW. 
IW WORKSPACE AN INTEGER ARRAY OF LENGTH LENIW. 
RW WORKSPACE A REAL ARRAY OF LENGTH LENRW. 
NOTE. LSQR DOES NOT EXPLICITLY USE THE PREVIOUS FOUR 
PARAMETERS, BUT PASSES THEM TO SUBROUTINE APROD FOR 
POSSIBLE USE AS WORKSPACE. IF APROD DOES NOT NEED 
IW OR RW, THE VALUES LENIW = 1 OR LENRW = 1 SHOULD 
BE USED, AND THE ACTUAL PARAMETERS CORRESPONDING TO 
IW OR RW MAY BE ANY CONVENIENT ARRAY OF SUITABLE TYPE. 
U(M) INPUT THE RHS VECTOR B. BEWARE THAT U_ IS 
OVER-WRITTEN BY LSQR. 
V(N) WORKSPACE 
W(N) WORKSPACE 
X(N) OUTPUT RETURNS THE COMPUTED SOLUTION xX. 
SE(N) OUTPUT RETURNS STANDARD ERROR ESTIMATES FOR THE 
COMPONENTS OF X. FOR EACH I, SE(I) IS SET 
TO THE VALUE RNORM * SQRT( SIGMA(I,I) / T ), 
WHERE SIGMA(I,I) IS AN ESTIMATE OF THE I-TH 
DIAGONAL OF THE INVERSE OF ABAR(TRANSPOSE) *ABAR 
AND T= 1 IF M .LE. N, 
T=M-N IF M.GT. N AND DAMP = Q, 
T=M IF DAMP .NE. @. 
ATOL INPUT AN ESTIMATE OF THE RELATIVE ERROR IN THE DATA 
DEFINING THE MATRIX A. FOR EXAMPLE, 
IF A IS ACCURATE TO ABOUT 6 DIGITS, SET 
ATOL = 1.@E-6 . 
BTOL INPUT AN ESTIMATE OF THE RELATIVE ERROR IN THE DATA 
DEFINING THE RHS VECTOR B. FOR EXAMPLE, 
IF B IS ACCURATE TO ABOUT 6 DIGITS, SET 
CONLIM INPUT AN UPPER LIMIT ON COND(ABAR), THE APPARENT 


CONDITION NUMBER OF THE MATRIX ABAR. 
ITERATIONS WILL BE TERMINATED IF A COMPUTED 
ESTIMATE OF COND(ABAR) EXCEEDS CONILIM. 

THIS IS INTENDED TO PREVENT CERTAIN SMALL OR 
ZERO SINGULAR VALUES OF A OR ABAR FROM 
COMING INTO EFFECT AND CAUSING UNWANTED GROWTH 
IN THE COMPUTED SOLUTION. 


CONLIM AND DAMP MAY BE USED SEPARATELY OR 
TOGETHER TO REGULARIZE ILL-CONDITIONE)D SYSTEMS. 


NORMALLY, CONLIM SHOULD BE IN THE RANGE 

19¢@ TO 1/RELPR. 

SUGGESTED VALUE — 

CONLIM = 1/(1@@*RELPR) FOR COMPATIBLE SYSTEMS, 
CONLIM = 1/(1@*SQRT(RELPR)) FOR LEAST SQUARES. 


1gl. 
192. 
193. 
164. 
105. 
166. 
107. 
198. 
109. 
119. 
111. 
112. 
113. 
114. 
115. 
116. 
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118. 
119. 
120. 
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124. 
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143. 
144. 
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NOTE. 


IF THE USER IS NOT CONCERNED ABOUT THE PARAMETERS 


ATOL, BTOL AND CONLIM, ANY OR ALL OF THEM MAY BE SET 


TO ZERO. 


THE EFFECT WILL BE THE SAME AS THE VALUES 


RELPR, RELPR AND 1/RELPR RESPECTIVELY. 


ITNLIM INPUT 


NOUT INPUT 


ISTOP OUTPUT 


¢ 


7 


ANORM OUTPUT 


ACOND OUTPUT 


RNORM OUTPUT 


ARNORM OUTPUT 


AN UPPER LIMIT ON THE NUMBER OF ITERATIONS. 
SUGGESTED VALUE -- 

ITNLIM = N/2 FOR WELL CONDITIONED SYSTEMS, 
ITNLIM = 44N - OTHERWISE. 


FILE NUMBER FOR PRINTER. IF POSITIVE, 
A SUMMARY WILL BE PRINTED ON FILE NOUT. 


AN INTEGER GIVING THE REASON FOR TERMINATION... 


X = $ IS THE EXACT SOLUTION. 
NO ITERATIONS WERE PERFORMED. 


THE EQUATIONS A*X = B- ARE PROBABLY 
COMPATIBLE. NORM(A*X - B) IS SUFFICIENTLY 
SMALL, GIVEN THE VALUES OF ATOL AND BTOL. 


THE SYSTEM A*X = B IS PROBABLY NOT 
COMPATIBLE. A LEAST-SQUARES SOLUTION HAS 


“BEEN OBTAINED WHICH IS SUFFICIENTLY ACCURATE, 


GIVEN THE VALUE OF ATOL. 


AN ESTIMATE OF COND(ABAR) HAS EXCEEDED 
CONLIM. THE SYSTEM A*X = B APPEARS TO BE 
ILL-CONDITIONED. OTHERWISE, THERE COULD BE AN 
AN ERROR IN SUBROUTINE APROD. 


THE EQUATIONS A*X = B ARE PROBABLY 
COMPATIBLE. .NORM(A*X - B) IS AS SMALL AS 
SEEMS REASONABLE ON THIS MACHINE. 


THE SYSTEM A*X = B IS PROBABLY NOT 
COMPATIBLE. A LEAST-SQUARES SOLUTION HAS 
BEEN OBTAINED WHICH IS AS ACCURATE AS SEEMS 
REASONABLE ON THIS MACHINE. 


COND(ABAR) SEEMS TO BE SO LARGE THAT THERE IS 
NOT MUCH POINT IN DOING FURTHER ITERATIONS, 
GIVEN THE PRECISION OF THIS MACHINE. 

THERE COULD BE AN ERROR IN SUBROUTINE APROD. 


THE ITERATION LIMIT ITNLIM WAS REACHED. 


AN ESTIMATE OF THE FROBENIUS NORM OF ABAR. 
THIS IS THE SQUARE-ROOT OF THE SUM OF SQUARES 
OF THE ELEMENTS OF ABAR. 

IF DAMP IS SMALL AND IF THE COLUMNS OF A 
HAVE ALL BEEN SCALED TO HAVE LENGTH 1.4, 
ANORM SHOULD INCREASE TO ROUGHLY SQRT(N). 

A RADICALLY DIFFERENT VALUE FOR ANORM MAY 
INDICATE AN ERROR IN SUBROUTINE APROD (THERE 


MAY BE AN INCONSISTENCY BETWEEN MODES 1 AND 2). 


AN ESTIMATE OF COND(ABAR), THE CONDITION 
NUMBER OF ABAR. A VERY HIGH VALUE OF ACOND 
MAY AGAIN INDICATE AN ERROR IN APROD. 


AN ESTIMATE OF THE FINAL VALUE OF NORM(RBAR), 
THE FUNCTION BEING MINIMIZED (SEE NOTATION 
ABOVE). THIS WILL BE SMALL IF A*X = B_ HAS 
A SOLUTION. 


AN ESTIMATE OF THE FINAL VALUE OF 

NORM( ABAR(TRANSPOSE)*RBAR ), THE NORM OF 
THE RESIDUAL FOR THE USUAL NORMAL EQUATIONS. 
THIS SHOULD BE SMALL IN ALL CASES. (ARNORM 
WILL OFTEN BE SMALLER THAN THE TRUE VALUE 
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COMPUTED FROM THE OUTPUT VECTOR X.) 
XNORM OUTPUT AN ESTIMATE OF THE NORM OF THE FINAL 
SOLUTION VECTOR X. 


SUBROUTINES AND FUNCTIONS USED 


USER APROD 
LSQR NORMLZ 
BLAS SCOPY,SNRM2,SSCAL (SEE LAWSON ET AL. BELOW) 


(SNRM2 IS USED ONLY IN NORMLZ) 
FORTRAN ABS, MOD, SQRT 


THE NUMBER OF ITERATIONS REQUIRED BY LSQR WILL USUALLY DECREASE 
IF THE COMPUTATION IS PERFORMED IN HIGHER PRECISION. TQ CONVERT 
LSQR AND NORMLZ BETWEEN SINGLE- AND DOUBLE-PRECISION, CHANGE 
THE WORDS 

SCOPY, SNRM2, SSCAL 

ABS, REAL, SQRT 
TO THE APPROPRIATE BLAS AND FORTRAN EQUIVALENTS. 


REFERENCES 


PAIGE, C.C. AND SAUNDERS, M.A. LSQR: AN ALGORITHM FOR SPARSE 
LINEAR EQUATIONS AND SPARSE LEAST SQUARES. 
ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE 8, 1 (MARCH 1982). 


LAWSON, C.L., HANSON, R.J., KINCAID, D.R. AND KROGH, F.T. 
BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE. 
ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE 5, 3 (SEPT 1979), 
398-323 AND 324-325. 


583-P 12- 


0 


COLLECTED ALGORITHMS FROM ACM 
| | 584-P 1- 0 


ALGORITHM 584 
CUBTRI: Automatic Cubature 
over a Triangle 


D. P. LAURIE 
National Research Institute for Mathematical Sciences, South Africa 


Categories and Subject Descriptors: G.1.4 [Numerical Analysis]: Quadrature and Numerical Differ- 
entiation—adaptive quadrature, multiple quadrature; G.m [Mathematics of Computing]: Miscel- 
laneous—FORTRAN 


General Terms: Algorithms, Theory 


Additional Key Words and Phrases: Quadrature rule 


DESCRIPTION AND PURPOSE 


Given a triangle T with vertices (é;, t2;), 7 = 1, 2, 3, a function f(x, y) defined on 
T, and a tolerance « > 0, CUBTRI attempts to compute a number A such that 


ja-| f(x, y) dx ay| < max {e, | Ae|}. (1) 
T ' : \ 


The method employed is similar to that of Haegemans [1] and consists of the 
following steps. 


(1) Compute an approximate integral A and error estimate y for the original 
triangle T. 

(2) If the current values of A and 7 satisfy 7 < max{e, |Ae|}, or if further 
computation will exceed specified limits, exit. 

(3) Given a list of triangles whose union is T, together with an approximate 
integral and error estimate for each triangle, identify the triangle T, with 
largest error estimate. 

(4) Remove 7; from the data list and subtract its contributions from the current 
values of A and 7. 

(5) Divide T; into four congruent triangles, append them to the data list, and 
compute an approximate integral and error estimate for each. Add these 
contributions to A and 7. 

(6) Diagnose whether rouna-off errors are contaminating the obtained values to 
a point where further subdivision is futile. If so, exit; else return to step 2. 


The general strategy falls within the framework outlined by Rice [7], apart 
from the test for roundoff, which is due to Piessens [5] and also appears in 
Haegemans’ routine TRIADA [1]. 
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Table I. The Integration Formula Pair Used by CUBTRI 


i wy re cP wi? wy 
0 1/3 1/3 1/3 9/40 7137 /62720 
—450/1568 
1,2 3/7 2/7 31/80 —9301697 /4695040 
+2/21 ¥/21 =ti) F/400 ¥13517313¢/23475200 
+7648850/939008 
+19876360/939008 
3,4 4/9 5/18 102791225 /59157504 
+o/9 ¥/18 ={f) 0 +23876225/59157504 
+a/9 —o/18 —345008750/59157504 
¥ob/45 +o0o/90 ¥99148250/59157504 
5 =¢) cy 4/9 0 11075/8064 
+0/9 —1250/288 
o= V15,0= V7 sae 
: | ec : ; 
Q°F me yD IGE 
k=] l=] 
kel 


Of= A y w)Q”F 


Qf= AY wiiQ°F 


A = area of triangle 


are barycentric coordinates 


CUBTRI attempts to improve on TRIADA in terms of number of function 
evaluations and storage management. 


NUMBER OF FUNCTION EVALUATIONS 


Two cubature rules @: and Q2 are applied to each triangle to produce estimates 
A, and Ag, where.A2 is of a higher degree than A,. This gives an approximate 
integral A = A2 and error estimate 7» = | Az — A:| which is likely to be pessimistic, 
since it really estimates the error in A; rather than that in A:. This effect is 
countered by employing a device given in [3] for sharpening the error estimate. 
It is, of course, possible to use two completely independent cubature rules (e.g., 
Haegemans [1] uses conic product Gauss formulas (see Stroud [8], Section 2.5) 
with 36 and 49 points, respectively), but it seems sensible to extend Kronrod’s [2] 
idea, that Q2 should reuse the points of Q@,, to the two-dimensional case. 

In CUBTRI, Q; is the 7-point degree-5 rule of Radon [6], and Q2 is a new 19- 
point degree-8 rule given in Table I. The theory of Lyness and Jespersen [4] 
shows that 19 points and degree 8 are optimal, given that Q2 has D; symmetry 
and contains the 7 points of Q;. A curious feature of Q2 is that the 12 new points 
are the intersection points of three pairs of parallel lines (see Figure 1). 


STORAGE MANAGEMENT 


Most of the storage requirements arise from the need to store a list of triangles. 
In general, 6 numbers are necessary to describe a triangle (e.g., three vertices of 
two coordinates each), giving a total of 6n numbers for 7 triangles. 

Haegemans [1] has improved on this by keeping a separate list of vertices; each 
triangle can then be described by 3 integers. The length of the list is only n + 2, 
because each subdivision creates as many new vertices (three) as the net increase 
in the number of triangles. This yields a total of 3n integers and 2n + 4 reals. 

In CUBTRI we take advantage of the fact that the sides of each subtriangle 
are parallel to those of the original triangle. Geometrically, one can visualize the 
subtriangle as being obtained by translation, scaling. and possibly rotation 
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Fig. 1. Disposition of points in the 
degree-8 formula. *-—Additional 
points of degree-8 formula. —Points 
of Radon’s degree-5 formula. 


through 180°. These effects can be represented by two coordinates, a scale factor, 
and the sign of the scale factor, respectively: thus three numbers per triangle 
suffice. It is convenient to use barycentric coordinates for the translation vector, 
because in that case only numbers that are terminating binary fractions are 
generated; these are exact machine numbers (even in single precision) on most 
computers, and rounding errors are avoided. Only 3n reals are therefore required 
in addition to the vertices of T. 


TESTS 


The driver main program and function f(x, y) supplied with the algorithm 
calculate the following seven integrals, 

Case 1. 
_ log(2 + v3) 


~i x 
(x? + 3y”)"!” dy dx 
a] [ 


This integrand has a singularity at the origin. 


Case 2. The same as Case 1, with a rapidly oscillatory relative error of 
magnitude 10~° perturbing the integrand. This simulates the behavior of a 
machine with a short word length. 


Case 3. 
1 a 
[ | te aar-F 
0 0 8 


_ fl, (x-4)?+(y—- 4)’ S$}, 
Mx, y) = ie otherwise. 


where 


This integrand has a jump discontinuity along a curved line, the circle of radius 
4 centered at (4, 4). 


The following four test functions were suggested by Haegemans [1]. 
Case 4. 


1 1-x : 
| | exp(sin x cos y) dy dx = 0.6918104506612316. 
0 0 
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Table II. f(x, y) = (x? + 3y?)"'”? 
CUBTRI TRIADA 


€ NFE EST ERR IER NFE EST ERR IER 
1 10-3 323 6.210— 6.1 10-4 0 765 9.1 107-4 3.010-3 0 
liom 551 8.510-5 7.510-5 0 2125 5.7 10-3 1.9j9-4 0 
Vio 1007 8.130-# 1.5j0-8 0 3145 7.110~8 2.310-5 0 
Lio-6 1919 8.610-7 3.7 10-8 0 4165 9.0j0-7 2.9i0-6 0 
Lio 3135 9.9j0-8 3.010-9 0 5525 6.310-8 1.8107 0 
Lio-8 5035 9.510-9 1.2j9—10 0 7225 9.510-9 6.610-9 0 
Lyo-9 7391 9.8j0—-10 7.6i0-"! 0 10285 9.83010 9.8j9—10 0 

10 
Table III. f(x,y) = (x? + 3y?)"'(1 + 9), |n | Ss 107° 
CUBTRI TRIADA 

€ NFE EST ERR IER NFE EST ERR IER 
lio 323 6.210— 6.110— 0 765 9.110-4 3.030-3 0 
Lio-+ 551 8.510-5 7.519-5 0 2125 5.710-5 1.9;0-4 0 
yo 1007 8.2 19-4 1.5y0-—4 0 3145 7.210-6 2..310—5 0 
Lio 1919 8.610—7 2.830-8 0 4165 9.7 0-7 2910-6 0 
Lio—? 3135 9.80-8 1.110-8 0 6205 1.0j0-7 §.9i0-2 0 
Lyo—8 5415 1.30-8 1.5y0-8 4 9945 6.510-8 1.7 19-10 2 

| Le Serre (| 1\, 1\, 
_ ee ——. _— _ a 
Table IV. f(x, y) 573 sen| i (= :) ( y ;) } 
CUBTRI TRIADA 

€ NFE EST ERR IER NFE EST ERR IER 
Lio—3 551 3.9}0-3 2.610—3 4 10625 9.9 30-4 6.449-5 0 
lio- 3059 2.010-3 5.710-4 4 14705 9.3i0-4 3.010-4 1 


This integral seems to be impossible to evaluate analytically; the numerical 
“exact” value is given in [1]. 


Case 5. 
1 I-—x 2 
x 1l+log2 7 
——~— dy dx = ——— —., 
[| q+2)° 2 4 


The integrand depends on x only. 
Case 6. 


1 1—x 
1 ) 
| | sin(3x + 6y) dy dx = 5 sin 3 — ie sin 6. 
0 0 


A mildly oscillating integrand. 
Case 7. 


1 1-x 2 
i | sin(x + y)7'”? dy dx ==. 
0 0 3 


The integrand has a gentler singularity at the origin than that of Case 1. 

In Tables II-VIII we report the results obtained by CUBTRI as well as by 
TRIADA [2] on a CDC Cyber 174 (48-bit mantissa, binary floating point). The 
column legends are 


€ Required tolerance. 

NFE Number of function evaluations. 
EST Estimated absolute error. 

ERR Actual absolute error. 
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Table V. f(x, ¥) = exp(sin x cos y) 


CUBTRI TRIADA 
€ NFE EST ERR IER NFE EST ERR IER 
lyo-3 19 1.8)9-5 2.610-9 0 85 1.5y0—10 2.3 19-12 0 
ljo-5 95 A.Qio—11 4,610-2 0 85 1.53910 2.319-2 0 
Table VI. f(x,y) =x2/(1 + x2) 
CUBTRI TRIADA 
€ NFE EST ERR IER NFE EST ERR IER 
lio 19 3.2}0-5 1.710-7 0 85 8.6 39-10 6.0;0—1 0 
lio-s 95 7.219-10 3.610-10 0 85 8.6 49—10 6.0;9—"" 0 
' Table VII. f(x, y) = sin(3x + 6y) ; 
CUBTRI TRIADA 
€ NFE EST ERR IER NFE EST ERR IER 
Lyo-3 19 3.310—4 2.130-8 0 85 1.9j0-9 2.1i0-"1 0 
Lio-4 95 1.610-9 1.3;9—11 0 85 ' 1.9j0-9 2.1j9-11 0 
te) 171 8.7 9-10 2.9i9—1 0 425 2.4j9—-12 4.8 9-15 0 
Table VIII. f(x+y)=(x+y)"” 
CUBTRI TRIADA 
€ NFE EST ERR IER NFE EST ERR IER 
lio-3 95 1.4)09— 1.419— 0 85 3.210—-4 6.210-4 0 
Lio— 171 4.9395 4.9105 ; 0 765 4.8395 9.8106-5 0 
1jo-5 323 6.330-6 : 6.110- 0 1445 6.0106 1.239-5 0 
Lio-6 475 9.440-7 7.7T10-7 0 2125 7.610—7 1.530-6 0 
Lio—? 1007 7.230-8 1.2)0-8 0 2805 9.539-8 1.9}9—7 0 
140-8 1615 9.110-9 1.5y0-2 0 3825 4.219-9 8.419—9 0 
Lio-9 2375 8.8i9—10 5.610—1 0 4505. 5.539—-10 1.1i9-9 0 


IER Error flag. For TRIADA, IER = 1 denotes that the limit on NFE has been 
reached, and IER = 2 that the round-off error threshold has been reached. 
For CUBTRI, the meaning of IER is explained in the leading comments. 


We can draw the following conclusions. 


(1) Reliability. The error estimates produced by CUBTRI after subdivision 
range from 0.87 to 120 times the actual error, and in only one instance is the 
actual error underestimated. Before subdivision (i.e., when NFE = 19), the device 
[3] is unavailable, and the overestimation is much more pessimistic. The error 
estimates produced by TRIADA range from 0.3 to 500 times the actual error, and 
in 16 instances (all involving nonsmooth integrands) the actual error is underes- 
timated. 

(2) Accuracy. On smooth integrands TRIADA is slightly more accurate than 
CUBTRI (e.g., in Case 2, TRIADA with NFE = 85 produces ERR = 2.31”). On 
nonsmooth integrands CUBTRI is much more accurate than  TRIADA (e.g., in 
Case 1, CUBTRI with NFE = 1919 produces ERR =3.7;3, whereas TRIADA 
with NFE = 2125 can only obtain ERR = 1.970). 

(3) Efficiency. On smooth integrands TRIADA in 15 instances out of 21 
terminated at a given e« with fewer function evaluations than CUBTRI. On 
nonsmooth integrands, in 20 instances out of 21 CUBTRI terminated with fewer 
function evaluations than TRIADA. 
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On machines with a short word length, termination with IER = 4 can be 
expected when «¢ is smaller than machine accuracy, and the behavior of the 
algorithm when e« is close to machine accuracy might be somewhat different. The 
situation is simulated by the difference between Cases 1 and 2. 

To summarize, CUBTRI is a reliable and efficient integrator on smooth as well 
as nonsmooth integrands, although not quite so accurate and efficient for smooth 
integrands as TRIADA. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Distribution Service. 
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SUBROUTINE CUBTRI(F, T, EPS, MCALLS, ANS, ERR, NCALLS, W, NW, cuB 1¢ 
* IDATA, RDATA, IER) CUB 20 
CUB 3¢ 

ADAPTIVE CUBATURE OVER A TRIANGLE cUuB 4@ 
CUB 5¢@ 

PARAMETERS CUB 60 
F - USER SUPPLIED EXTERNAL FUNCTION OF THE FORM CUB 7¢@ 
F(X,Y, IDATA, RDATA) CUB 8@ 

WHERE X AND Y ARE THE CARTESIAN COORDINATES OF A CUB 9@ 

POINT IN THE PLANE, AND IDATA AND RDATA ARE INTEGER CUB 160 

AND REAL VECTORS IN WHICH DATA MAY BE PASSED. CUB 11¢ 

vi - ARRAY OF DIMENSION (2,3) WHERE T(1,J) AND T(2,J) CUB 12¢ 
ARE THE X AND Y COORDINATES OF THE J-TH VERTEX OF CUB 13¢ 

THE GIVEN TRIANGLE (INPUT) CUB 14¢ 

EPS —- REOUVIRED TOLERANCE (INPUT). IF THE COMPUTED CUB 150 
INTEGRAL IS BETWEEN-1 AND 1, AN ABSOLUTE ERROR CUB 16¢ 

TEST IS USED, ELSE A RELATIVE ERROR TEST IS USED. CUB 17¢ 

MCALLS- MAXIMUM PERMITTED NUMBER OF CALLS TO F (INPUT) CUB 18¢@ 
ANS - ESTIMATE FOR THE VALUE OF THE INTEGRAL OF F OVER CUB 19¢ 
THE GIVEN TRIANGLE (OUTPUT) CUB 20¢ 

ERR - ESTIMATED ABSOLUTE ERROR IN ANS (OUTPUT) CUB 21¢ 
NCALLS- ACTUAL NUMBER OF CALLS TO F (OUTPUT). THIS CUB 22¢ 
PARAMETER MUST BE INITIALIZED ‘TO @ ON THE FIRST CUB 23¢@ 

CALL TO CUBTRI FOR A GIVEN INTEGRAL (INPUT) CUB 24¢ 

W - WORK SPACE. MAY NOT BE DESTROYED BETWEEN CALLS TO CUB 25@ 
CUBTRI IF RESTARTING IS INTENDED CUB 26@ 

NW - LENGTH OF WORK SPACE (INPUT). CUB 27¢ 

IF NW .GE. 3*(19+3*MCALLS)/38, TERMINATION DUE TO CUB 280 

FULL WORK SPACE WILL NOT OCCUR. CUB 290 

IER - TERMINATION INDICATOR (OUTPUT) CUB 340 
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IER=$ NORMAL TERMINATION, TOLERANCE SATISFIED 
IER=1 MAXIMUM NUMBER OF CALLS REACHED 
IER=2 WORK SPACE FULL 


IER=3 FURTHER SUBDIVISION OF TRIANGLES IMPOSSIBLE 


IER=4 NO FURTHER IMPROVEMENT IN ACCURACY IS 
POSSIBLE DUE TO ROUNDING ERRORS IN FUNCTION 
VALUES 

IER=5 NO FURTHER IMPROVEMENT IN ACCURACY IS 
POSSIBLE BECAUSE SUBDIVISION DOES NOT 
CHANGE THE ESTIMATED INTEGRAL. MACHINE 
ACCURACY HAS PROBABLY BEEN REACHED BUT 
THE ERROR ESTIMATE IS NOT SHARP ENOUGH. 


CUBTRI IS DESIGNED TO BE CALLED REPEATEDLY WITHOUT WASTING 
EARLIER WORK. THE PARAMETER NCALLS IS USED TO INDICATE TO 
CUBTRI AT WHAT POINT TO RESTART, AND MUST BE RE-INITIALIZED 
TO @ WHEN A NEW INTEGRAL IS TO BE COMPUTED. AT LEAST ONE OF 
THE PARAMETERS EPS, MCALLS AND. NW MUST BE CHANGED BETWEEN 
CALLS TO CUBTRI, ACCORDING TO THE RETURNED VALUE OF IER. NONE 
OF THE OTHER PARAMETERS MAY BE CHANGED IF RESTARTING IS DONE. 
IF IER=3 IS ENCOUNTERED, THERE PROBABLY IS A SINGULARITY 
SOMEWHERE IN THE REGION. THE ERROR MESSAGE INDICATES THAT 


FURTHER SUBDIVISION IS IMPOSSIBLE BECAUSE THE VERTICES OF THE 


SMALLER TRIANGLES PRODUCED WILL BEGIN TO COALESCE TO THE 
PRECISION OF THE COMPUTER. THIS SITUATION CAN USUALLY BE 
RELIEVED BY SPECIFYING THE REGION IN SUCH A WAY THAT THE 
SINGULARITY IS LOCATED AT THE THIRD VERTEX OF THE TRIANGLE. 
IF IER=4 IS ENCOUNTERED, THE VALUE OF THE INTEGRAL CANNOT BE 


IMPROVED ANY FURTHER. THE ONLY EXCEPTION TO THIS OCCURS WHEN A 


FUNCTION WITH HIGHLY IRREGULAR BEHAVIOUR IS INTEGRATED (E.G. 


FUNCTIONS WITH JUMP DISCONTINUITIES OR VERY HIGHLY OSCILLATORY 


FUNCTIONS). IN SUCH A CASE THE USER CAN DISABLE THE ROUNDING 


ERROR TEST BY REMOVING THE IF STATEMENT SHORTLY AFTER STATEMENT 


NUMBER 7@. 


SUBROUTINE CUBRUL(F, VEC, P, IDATA, RDATA) 


BASIC CUBATURE RULE PAIR OVER A TRIANGLE 


PARAMETERS 
F —- EXTERNAL FUNCTION - SEE COMMENTS TO CUBTRI 
VEC- MATRIX OF BASE VECTORS AND ORIGIN (INPUT) 
P - TRIANGLE DESCRIPTION VECTOR OF DIMENSION 6 


P(1) - TRANSFORMED X COORDINATE OF ORIGIN VERTEX( INPUT) 
P(2) - TRANSFORMED Y COORDINATE OF ORIGIN VERTEX( INPUT) 


P(3) - DISTANCE OF OTHER VERTICES IN THE DIRECTIONS 
OF THE BASE VECTORS (INPUT) 

P(4) = LESS ACCURATE ESTIMATED INTEGRAL (OUTPUT) 

P(5) - MORE ACCURATE ESTIMATED INTEGRAL (OUTPUT) 

P(6) - ABS(P(5)~P(4)) (OUTPUT) 


CUBRUL EVALUATES A LINEAR COMBINATION OF BASIC INTEGRATION 


RULES HAVING D3 SYMMETRY. THE AREAL COORDINATES PERTAINING TO 
THE J-TH RULE ARE STORED IN W(I,J),I=1,2,3. THE CORRESPONDING 


WEIGHTS ARE W(4,J) AND W(5,J), WITH W(5,J) BELONGING TO THE 
MORE ACCURATE FORMULA. IF W(1,J).EQ.W(2,J), THE INTEGRATION 


POINT IS THE CENTROID, ELSE IF W(2,J).EQ.W(3,J), THE EVALUATION 
POINTS ARE ON THE MEDIANS. IN BOTH CASES ADVANTAGE IS TAKEN OF 


SYMMETRY TO AVOID REPEATING FUNCTION EVALUATIONS. 


THE FOLLOWING DOUBLE PRECISION VARIABLES ARE USED TO AVOID 
UNNECESSARY ROUNDING ERRORS IN FLOATING POINT ADDITION. 

THEY MAY BE DECLARED SINGLE PRECISION IF DOUBLE PRECISION IS 
NOT AVAILABLE AND FULL ACCURACY IS NOT NEEDED. 


DOUBLE PRECISION Al, A2, S, SN, DZERO, DONE, DTHREE, DSIX 
REAL AREA, ORIGIN(2), P(6), RDATA(1), TVEC(2,3), VEC(2,3), W(5,6) 
INTEGER IDATA(1) 


W CONTAINS POINTS AND WEIGHTS OF THE INTEGRATION FORMULAE 
NQUAD - NUMBER OF BASIC RULES USED 


THIS PARTICULAR RULE IS THE 19 POINT EXTENSION (DEGREE 8) OF 
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THE FAMILIAR 7 POINT RULE (DEGREE 5). 


SIGMA=SQRT (7) 


PHI=SQRT(15) 
W(1,1),W(2,1),W(3,1) = 1/3 
w(4,1) = 9/40 
W(5,1) = 7137/62720 - 45*SIGMA/1568 
W(1,2) = 3/7 + 2*PHT/21 
W(2,2),W(3,2) = 2/7 - PHI/21 
W(4,2) = 31/80 - PHI/440 
W(5,2) = — 9301697/469504@ - 13517313*PHI/ 23475200 
+ 764885*SIGMA/ 939008 + 198763*PHI*SIGMA/939008 
W(*,3) = W(*,2) WITH PHI REPLACED BY -PHI 
W(1,5) = 4/9 + PHI/9 + SIGMA/9 - SIGMA*PHI/45 
W(2,5),W(3,5) = 5/18 - PHI/18 - SIGMA/18 + SIGMA*PHI/9@ 
w(4,5) = @ 


W(5,5) = 102791225/59157504 + 23876225*PHI/59157504 
- 34500875*SIGMA/59157504 - 9914825*PHI*SIGMA/59157504 
W(*,4) = W(*,5) WITH PHI REPLACED BY -PHI 
W(1,6) = 4/9 + SIGMA/9 
W(2,6) = W(2,4) 
W(3,6) = W(2,5) 
W(4,6) = @ 
W(5,6) = 110675/8064 - 125*SIGMA/288 
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380 
390 
400 
410 
426 
430 
440 
450 
460 
470 
480 
490 
500 
510 
526 
530 
540 
55@ 
560 
570 
580 
590 
600 
61¢ 
620 
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ALGORITHM 585 
A Subroutine for the General Interpolation 
and Extrapolation Problems 


C. BREZINSKI 
University of Lille, France 


Categories and Subject Descriptors: Gm [Mathematics of Computing]: Miscellaneous— 
FORTRAN 


General Terms: Algorithms 


Additional Key Words and Phrases: Convergence acceleration, extrapolation, interpolation, least 
squares approximation, Neville-Aitken scheme 


1. INTRODUCTION 


Recently a generalization of Neville-Aitken algorithm for extrapolation has been 
found by Havie [10]. This general extrapolation scheme has also been studied by 
Brezinski [3], who showed that it includes most of the convergence acceleration 
methods actually known. This algorithm has been called the E-algorithm, or the 
BH-protocol [15, Chaps. 10 and 11, pp. 175-209]. 

Of course, after that, the next step was to look for a general interpolation 
scheme for interpolation by a linear combination of functions forming a Che- 
byshev system. Such an algorithm was in fact found some years ago by Muhlbach 
[12, 13]. Except for the initializations, it is the same as the E-algorithm. This 
algorithm has been called the Muhlbach-Neville-Aitken algorithm (MNA-algo- 
rithm). The same algorithm can also be used for the general interpolation problem 
[4] as described, for example, by Davis [7]. 

The E-algorithm and its programming are described in Section 2. A FORTRAN 
subroutine is given with an application. Section 3 is devoted to the MNA- 
algorithm, while Section 4 deals with least squares approximation and extrapo- 
lation. 


2. THE E-ALGORITHM 
Let (S,) be a sequence of real numbers and let us consider the sequence 
transformation defined by 

Sr Sr+1 ane Snake 
&iln) gitnt+1)-+» gilnt+k) 


ee 


1 rar 1 
&i(n) gi(n+1)--- gi(nt+h) 


—— ee eS ee me eee ee ee 


er(n) ge(nt+1)--» gen +k) 


Received 20 June 1980; revised 30 January 1981; accepted 25 March 1982 

This work was partly supported by NATO Research Grant 027-81. 

Author’s address: Université des Sciences et Techniques de Lille, B.P. 36, 59655 Villeneuve d’Ascq 
Cedex, France. 

Permission to copy without fee all or part of this material is granted provided that the copies are not 
made or distributed for direct commercial advantage, the ACM copyright notice and the title of the 
publication and its date appear, and notice is given that copying is by permission of the Association 
for Computing Machinery. To copy otherwise, or to republish, requires a fee and/or specific 
permission. 

© 1982 ACM 0098-3500/82/0900-0290 $00.75 


ACM Transactions on Mathematical Software, Vol. 8, No. 3, September 1982, Pages 290-301. 


COLLECTED ALGORITHMS (cont.) 585-P 2- 0 


where the g;’s are given sequences such that the denominator in E,,(S,,) does not 
vanish. 

The main basic algebraic property of this transformation is that Vn = N, E;(S,) 
= S if the sequence (S,,) satisfies, Vn = N 


Sr =S+ aigi(n) + «++ + argz(n). 


This formalism is quite general since it includes most of the sequence transfor- 
mations actually used to accelerate the convergence of the sequence (S,). For 
example, if g;(n) = ASn+i-1, it is Shanks’ transformation [14]; if g;(n) = xi 'AS,, 
it is Levin’s method [11]; for gi(n) = xi, we recover Richardson extrapolation 
process; and for g;(n) = (AS,)', it is Germain-Bonne’s method [9]; and so forth. 

From the numerical point of view, a recursive method to avoid the computation 
of the determinants involved in E;(S,) is needed. Such algorithms exist for the 
particular cases quoted above: Wynn’s e-algorithm [16] for Shanks’ transforma- 
tion, Neville-Aitken’s scheme for Richardson process and Germain-Bonne’s trans- 
formation, some special devices [5] for Levin’s method, and so on. The corre- 
sponding FORTRAN subroutines can be found in [1]. Thus we have at least as 
many different algorithms as sequence transformations. 

Recently a recursive algorithm working in the general case has been obtained 
by Havie [10] and Brezinski [3]. This algorithm, called the E-algorithm, is as 
follows: 


Initializations EM=S,, n=0,1,... 
go, = gi(n), t=1,2,... and n=0,1,.... 
Then, for k = 1, 2,...andn=0,1,... 
EY,-— Ey 


EP =F? +2°..— (2.1) 
Bn Bea 
(1) ag (n+l) 
gel= 62 i+ Past PRA LRA... 22) 
8i-1,k — Ek-1k 
It can very easily be proved, by using Sylvester’s determinantal identity [8, Vol. 
1, p. 32] that 
EW = Ex (Sn). 


Usually the quantities Ej” are displayed in a two-climensional array, called the 
E-array, as follows: 

E A = So 

E o oa S, E® 

E®=8, EY EY’ 

E®=S, E® EY EY 


The g¥?’s can also be placed in similar arrays, the g;-arrays, for a fixed value of 
the index 1, where k indicates the column starting from zero. It is easy to check 
that g;”) = 0 for k = i, and thus the g;-array only contains the columns 0 to 
i-— 1. 

There are two methods for using, and thus for programming, convergence 
acceleration methods. The first one is to use them a posteriori, that is, to compute 
a fixed number of terms of the sequence (S,,) and then to apply the algorithm by 
computing each column of the array from the preceding one. This use is very 
easy to program, but it has the main disadvantage that all the computations must 
be started again from the beginning if one wants to add new terms to the initial 
sequence (S,,). 

The second use, which is much more convenient in practice, is to use the 
algorithm “in parallel” with the computation of the successive terms of the 
original sequence (S,,): After the computation of each new term of the sequence 
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(S,), one has to build the arrays as far as possible by computing each row from 
the preceding one and then to go back to the computation of the next term of 
(S,). Of course, this way of implementing the algorithms is much more compli- 
cated to program, but is it the only reasonable way. For a complete description 
of this use see [1] and for its special application to the E-algorithm see [3]. 

Let us now describe the arguments of the subroutine EXTRAP for the parallel 
use of the E-algorithm. 

The subroutine must be included in a loop where the successive terms of the 

sequence (S,,) are computed. Before the beginning of the loop the integer 

parameter INIT must be set to zero. Then the value of INIT is modified by the 
subroutine, and thus INIT might be set again to zero if one wants to use the 
subroutine later for another sequence. 

In the subroutine, E(Z) contains E{<7” for J = 1,..., min(K, MAXCOL + 1) 
after the Kth call, while G(, J)(I = 1, ..., min(K, MAXCOL)) contains g /4% 
for J=1,...,7—1, and gf79 for J=J,..., min(K, MAXCOL + 1). 

A partial listing of the subroutine EXTRAP follows: 


SUBROUTINE EXTRAP(INIT, EPS, MAXCOL, SK, GINIT, RESULT, INFO) EXT 1@ 
Cc EXT 2@ 
C STATEMENT OF PURPOSE EXT 3@ 
Cc KAEKAKKAARKARAKKAKKRKKK EXT 4@ 
C EXT 5@ 
C THE SUBPROGRAM EXTRAP() IS A SUBROUTINE TO IMPLEMENT THE E-ALGORITHMEXT 60 
C FOR SEQUENCE EXTRAPOLATION AND THE MUHLBACH-NEVILLE-AITKEN ALGORITHMEXT 76 
C FOR THE GENERAL INTERPOLATION PROBLEM. EXT 86 
Cc EXT 90 
Cc EXT 1066 
C DESCRIPTION OF THE PARAMETERS OF THE SUBROUTINE EXTRAP() EXT 1106 
Cc KAEKAKKKRKEKERERAKKEKRRRERERRRRKEKRRERERERRRERERRKRERRKEKKE EXT 129 
c EXT 136 
Cc EXT 146 
C INIT INTEGER PARAMETER TO BE SET TO ZERO BEFORE THE FIRST EXT 15¢ 
Cc CALL OF THE SUBROUTINE. DUE TO THE FACT THAT AFTER THE EXT 16¢ 
Cc COMPUTATION OF EACH ROW OF THE E-ARRAY ONE HAS TO EXIT THE EXT 170 
Cc SUBROUTINE TO COMPUTE THE NEW VALUES OF THE DATA SK AND EXT 18¢ 
Cc GINIT(*), ALL THE VARIABLES INTERNAL TO THE SUBROUTINE MUST EXT 190 
Cc REMAIN INTACT BETWEEN THE CALLS. THE SAME IS TRUE FOR THE EXT 266 
Cc ARGUMENTS INIT , MAXCOL AND INFO. THE VALUE OF EPS CAN BE EXT 21¢ 
Cc CHANGED. DURING THE FIRST CALL OF THE SUBROUTINE INIT IS EXT 226 
Cc CHANGED TO 1. TO USE THE SUBROUTINE FOR A NEW APPLICATION OF EXT 23 
C THE ALGORITHM (AND NOT FOR THE SUBSEQUENT CALLS CORRESPONDING EXT 240 
c TO THE SAME APPLICATION) INIT WILL HAVE TO BE SET AGAIN TO @. EXT 25¢ 
Cc EXT 26¢ 
C EPS THE AIM OF THIS PARAMETER IS TO AVOID A DIVISION BY ZERO. EXT 276 
Cc WHEN THE ABSOLUTE VALUE OF A DENOMINATOR IS LESS THAN EPS THE EXT 28¢ 
Cc PARAMETER INFO IS SET TO 1. EXT 2906 
c EXT 30¢ 
C MAXCOL INTEGER PARAMETER GIVING THE INDEX OF THE LAST COLUMN EXT 316 
Cc OF THE E-ARRAY THAT THE USER WANTS TO COMPUTE (SEE EXT 326 
Cc BELOW IN THE EXPLANATIONS FOR THE PARAMETER RESULT.) EXT 336 
Cc EXT 3406 
C SK DOUBLE PRECISION ARGUMENT WHICH MUST CONTAIN THE VALUE EXT 35¢ 
c OF S BEFORE THE K-TH CALL OF THE SUBROUTINE. EXT 3606 
Cc K-1 EXT 376 
C EXT 38¢ 
C GINIT DOUBLE PRECISION ARRAY WHICH MUST CONTAIN THE VALUES OF EXT 39¢ 
Cc G (@) BEFORE THE FIRST CALL OF THE SUBROUTINE, G (1) EXT 40¢ 
c 1 1 EXT 416 
C BEFORE THE SECOND CALL, G (K-1), G (K-1),...., G  (K-1), EXT 426 
c 1 2. K-2 EXT 430 
Cc G (6), G (1),...., G  (K-1) BEFORE THE K-TH CALL EXT 446 
Cc K-1 K-1 K-1 EXT 45¢@ 
Cc IF MAXCOL+1 J= K J= 3 AND G (K-1),...., G (K-1) IF EXT 46¢@ 
Cc 1 MAXCOL EXT 476 
Cc K J MAXCOL + 1 EXT 486 
Gs EXT 496 
C RESULT DOUBLE PRECISION ARGUMENT CONTAINING THE ANSWER GIVEN BY EXT 506@ 
Cc THE SUBROUTINE AFTER THE CALL. RESULT SUCCESSIVELY CONTAINS EXT 516 
c (9) (9) (0) (1) (2) EXT 526 
C E 5 5 Seaiey: EB ek » E EXT 53@ 
Cc @ 1 MAXCOL MAXCOL MAXCOL EXT 546 
Cc ; EXT 55¢@ 
C INFO INTEGER PARAMETER WHICH, ON NORMAL EXIT, HAS THE VALUE @. EXT 56¢@ 
Cc A NEGATIVE VALUE SIGNALS THAT DIMENSIONS ARE TOO SMALL IN EXT 576 
c THE SUBROUTINE. THE VALUE 1 INDICATES A DIVISION BY A EXT 580 
Cc QUANTITY SMALLER THAN EPS IN ABSOLUTE VALUE. IF INFO HAS A EXT 59¢ 
Cc VALUE DIFFERENT FROM ZERO IT 1S IMPOSSIBLE TO ENTER AGAIN EXT 6@ 
C INTO EXTRAP(). TO USE IT AGAIN THE PARAMETER INIT MUST BE EXT 61@ 
Cc SET TO @. EXT 626 
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Let us give an example of the use of this subroutine. It corresponds to the choice 
gi(m) = AS,+:-1 (Shanks’ transformation) for the sequence S, = 1/(n + 1). For 
this sequence it is known that E{” = e§? = 1/(k + 1)”. 


Cc PROGRAM TESTD (OUTPUT, TAPE6=OUTPUT) MAN 10 

Cc TEST DRIVER FOR THE EXTRAP SUBROUTINE MAN 26 

Cc IN THE E-ALGORITHM MAN 30 

C MAN 40 

INTEGER I, MAXCOL, INIT, INFO, K, M, MPI, NI MAN 50 

DOUBLE PRECISION KPI, SK, RESULT, S, GINIT, EPS, T MAN 6@ 

DIMENSION GINIT(5@) MAN 70 

Cc MAN 8@ 

DATA NOUT /6/, INIT /@/, MAXCOL /5/, EPS /1.D-30/ MAN 9¢ 

c MAN 160 

DO 46 K=1,2@ MAN 11¢ 

C MAN 1206 

Cc COMPUTATION OF S MAN 130 

Cc K-1 MAN 140 

Cc MAN 150 

T=K MAN 160 

SK = 1.D6/T MAN 170 

Cc MAN 186 

Cc COMPUTATION OF G (K-1) MAN 196 

Cc I MAN 2060 

Cc MAN 216 

M = MAX@(1,K-2) MAN 220 

DO 10 I=1,M MAN 236 

KPI =K+1 MAN 246 

GINIT(I) = ~1.D06/(KPI-1.D@)/KPI MAN 2506 

16 CONTINUE MAN 26¢ 

IF (K.LT.3 .OR. K.GT.MAXCOL+1) GO TO 3¢ MAN 276 

Cc MAN 286 

Cc COMPUTATION OF G_ (I-1) MAN 290 

Cc K-1 MAN 30¢ 

Cc MAN 316 

DO 2@ I=1,Kk MAN 320 

KPI = K+I1 MAN 330 

MPI =M+1 MAN 340@ 

GINIT(MPI) = -1.D6/(KPI-2.D@) /(KPI-1.D@) MAN 35¢@ 

26 CONTINUE MAN 3606 

3@ CALL EXTRAP(INIT, EPS, MAXCOL, SK, GINIT, RESULT, INFO) MAN 376 

IF (INFO.LT.@) WRITE (NOUT, 99998) MAN 38¢@ 

IF (INFO.EQ.1) WRITE (NOUT, 99997) MAN 39¢ 

THK MAN 406 

S = 1.D6/T**2 MAN 41¢ 

T = (MAXCOL+1) *K MAN 426 

IF (K.GT.MAXCOL+1) S = 1.D6/T MAN 43¢@ 

WRITE (NOUT,99999) RESULT, S MAN 44@ 

4@ CONTINUE MAN 45¢@ 

STOP MAN 46 

99999 FORMAT (3D26.12) MAN 47¢@ 

99998 FORMAT (46H DIMENSIONS TOO SMALL IN THE SUBROUTINE EXTRAP) MAN 480 

99997 FORMAT (42H DIVISION BY ZERO IN THE SUBROUTINE EXTRA!) MAN 496 

END MAN 560 
This program gives the results shown in Table I on a computer with precision 
107'* (DEC 10). The numbers printed are E,..., EH, EY,..., ES”, where the 


exact values are given by E{” = 1/((n + k + 1)(R + 1)). The E-algorithm can be 
quite sensitive to the propagation of rounding errors. Several possibilities exist 
for their control. The first one is to compute the “amplification factors” defined 
by Havie [9] which can be used to obtain an upper bound for the amplification of 
the initial errors and which can be considered as a measurement of the numerical 
stability of the algorithm. The second possibility consists in using the particular 
rules given in [4] although they are quite difficult to program and will lead to a 
much longer program. The third possibility is to use an exact arithmetic such as 
p-adic or rational arithmetic. Such an arithmetic is actually under consideration. 

A quite important practical problem when using convergence acceleration 
methods is that of the termination criteria. For some special sequences and some 
particular methods such a criterion can be obtained (see, for example, the 
discussion on totally monotonic and totally oscillating sequences and their treat- 
ment by Shanks’s transformation in [1]). In the general case some theorems exist 
[3, Theorem 3], but in practice the computations are stopped when two successive 
elements of the same column or the same diagonal of the E-array are nearly 
equal. 

To end this section let us mention that the relationships of the E-algorithm, as 
they are written in [3], are numerically unstable. These relations must be written 
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Table I 


Computed values 


Exact values 


0.100000000000D+01 0.100000000000D+01 
0.250000000000D+-00 0.250000000000D+00 
0.111111111111D+00 0.111111111111D+00 


0.625000000000D—01 
0.400000000000D—01 
0.277777777778D—01 
0.238095238096D—01 
0.208333333332D—01 
0.185185185190D—01 
0.166666666650D—01 
0.151515151566D—01 
0.138888888769D—01 
0.128205128394D—01 
0.119047618869D—01 
0.111111111178D—O1 
0.104166666706D—01 
0.980392156462D—02 
0.925925926345D—02 
0.877192979360D—02 
0.833333342965D—02 


0.625000000000D—01 
0.400000000000D—01 
0.277777777778D—01 
0.238095238095D—01 
0.208333333333D—01 
0.185185185185D—01 
0.166666666667D—01 
0.151515151515D—01 
0.138888888889D—01 
0.128205128205D—01 
0.119047619048D—01 
0.111111111111D-—01 
0.104166666667D—01 
0.980392156863D—02 
0.925925925926D—02 
0.877192982456D—02 
0.833333333333D—02 
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as they are in (2.1) and (2.2) and in the subroutine. In that way they will be much 
more stable. For example, if the unstable version of these rules is used, then, for 
the preceding example, we shall obtain for the last entry a result that is less 
accurate by three digits. 


3. THE MUHLBACH-NEVILLE-AITKEN ALGORITHM 


Let { fi}i=o be a family of linearly independent elements of a real vector space E. 
{ fi} is assumed to be a complete Chebyshev system with respect to the linear 
not zero whenever Lo, ..., Lz are linearly independent. 

The problem is to construct a generalized polynomial 


Pi = Aofo + +++ + Arfr 
such that 
Li(Pr) = wi, i=0,...,2, 


where the w,’s are given numbers not all zero. 
More generally one wants to construct 


P® = aofot+ eee + arf 
such that 
L(P) = wi, t=n,...,nt+k. 


This is the general interpolation problem as described, for example, by Davis [7]. 

Usually on a computer (and also often in numerical analysis) one deals with 
numbers and not with elements of a vector space. This means that, in practice, 
one has to compute the numerical values L(P£”) where L is a linear functional 
on £. (If F is a vector space of functions, then, for example, L(/) is the value of 
the function f at some prescribed point x.) 

Muhlbach [12, 13] showed that these values can be recursively computed by an 
algorithm that generalizes the Neville-Aitken scheme. For this reason it has been 
called the Muhlbach-Neville-Aitken algorithm (briefly, the MNA-algorithm). A 
very simple proof of the MNA-algorithm has been given in [4] using Sylvester’s 
determinantal identify. Except for the initializations, it is similar to the E- 
algorithm. 
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L(P\”) = wn er 

LFS?) = Lal ae Lif) 

Lip) = LPR L(P 1) — LP LIP”) 
LOS) — Le 

Lge) = LEELA PP) — LF EP 


LPR) — L free 


Thus the subroutine EXTRAP can still be used for computing the values of 
L(P¥). For example, if we choose 


fo(x) =e™* fi(x) =sinx fi(x) =x? f(x) =log x 
Lo (fi) = fi) Ly (fi) = fi(2) L2(fi) - | fix) dx = La(fi) = fi’ (1) 


w=Li(f) 1=0,...,3 with f(x) = 3f(x) + 4f(x) — f(x) + f(x) 
and L(P{) = P{(x), then the calling sequence is as follows: 


Cc PROGRAM TESTD (OUTPUT, TAPE6=OUTPUT) MAN 1@ 
c TEST DRIVER FOR THE EXTRAP SUBROUTINE IN THE MAN 2¢@ 
c MUHLBACH-NEVILLE-AITKEN ALGORITHM MAN 3@ 
Cc MAN 40 
INTEGER I, INIT, INFO, K, L, M, MPI, N, NI MAN 50 
DOUBLE PRECISION A, GINIT, F, P, RESULT, SK, W, X, EPS, T MAN 60 
DIMENSION A(1@,10), GINIT(40), F(16), W(10) MAN 7 

Cc MAN 8@ 
DATA N /4/, NOUT /6/, EPS /1.D-36/ MAN 9@ 

Cc MAN 106 
Cc N IS THE NUMBER OF TERMS IN THE LINEAR COMBINATION MAN 110 
Cc MAN 12@ 
Cc W(L) MUST CONTAIN W MAN 13@ 
Cc I-1 MAN 146 
Cc MAN 154 
W(1) = 3.DO*DEXP(-1.D@) + 4.D@*DSIN(1.D@) - 1.D¢ MAN 160 

W(2) = -3.DO*DEXP(-2.D0) + 4.D@*DCOS(2.D¢) - 3.5D¢ MAN 170 

W(3) = 6.D@ - 1.D6/3.D@ - 3.D@*DEXP(-1.D0) - 4.D¢*DCOS(1. D0) MAN 180 

W(4) = 3.DO*DEXP(-1.D0) - 4.D@*DSIN(1.D6) - 3.D0 MAN 19¢ 

Cc MAN 20¢ 
Cc A(I,J) MUST CONTAIN L (F_ ) MAN 210 
Cc I-1 J-1 MAN 22¢ 
c MAN 23¢ 
A(1,1) = DEXP(-1.D0) MAN 24¢@ 
A(2,1) = ~DEXP(-2.D0) MAN 25¢@ 
A(3,1) = 1.D@ - A(1,1) MAN 26¢@ 
A(4,1) = A(1,1) MAN 27¢ 
A(1,2) = DSIN(1.D@) MAN 28¢ 
A(2,2) = DCOS(2.D0) MAN 290 
A(3,2) = 1.D@ - DCOS(1.DO) MAN 300 
A(4,2) = -A(1,2) MAN 316 
A(1,3) = 1.D@ MAN 320 
A(2,3) = 4.D0 MAN 33¢ 
A(3,3) = 1.D¢/3.D0 MAN 346 
A(4,3) = 2.D¢ MAN 35¢ 
A(1,4) = 6.D¢ MAN 360 
A(2,4) = @.5D¢ MAN 376 
A(3,4) = -1.D0 MAN 38@ 
A(4,4) = -1.D¢ MAN 39¢ 

Cc MAN 40@ 
DO 5@ L=1,1¢@ MAN 410 

T=L MAN 42 

X = T*O.2D¢ MAN 43¢ 

Cc MAN 44@ 
c F(I) MUST CONTAIN F MAN 45¢ 
Cc I-1 MAN 46¢ 
Cc MAN 47¢ 
F(1) = DEXP(-X) MAN 48¢ 

F(2) = DSIN(X) MAN 49@ 

F(3) = X*X MAN 500 

F(4) = DLOG(X) MAN 510 

INIT = @ MAN 52@ 

DO 4@ K=1,N MAN 53@ 

SK -= W(K)*F(1)/A(K, 1) MAN 54¢ 

M = MAX@(1,K-2) MAN 5506 
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Cc (K-1) MAN 570 
Cc COMPUTATION OF F MAN 586 
Cc 6,1 MAN 59¢ 
Cc MAN 606 
DO 1@ I=1,M MAN 6106 

GINIT(L) = A(K,I+1)*F(1)/A(K,1) - F(I+1) MAN 626 

1¢ CONTINUE MAN 63¢ 

IF (K.LT.3) GO TO 3¢ MAN 646 

Cc MAN 656 
c (I-1) MAN 660 
Cc COMPUTATION OF F MAN 670 
Cc @,K-1 MAN 68¢@ 
Cc MAN 690 
DO 2@ I=1,K MAN 760 

MPI =M+I MAN 716 

GINIT(MPI) = A(I,K)*F(1)/A(I,1) - F(R) MAN 720 

26 CONTINUE MAN 730 

30 CALL EXTRAP(INIT, EPS, N-1, SK, GINIT, RESULT, INFO) MAN 740 

46 CONTINUE MAN 75@ 

IF (INFO.LT.@) WRITE (NOUT, 99998) MAN 760 

IF (INFO.EQ.1) WRITE (NOUT, 99997) MAN 770 

P = 3.DO*F(1) + 4.DO*F(2) - F(3) + F(A) MAN 78¢6 

WRITE (NOUT,99999) X, P, RESULT MAN 790 

5@ CONTINUE MAN 806 
STOP MAN 81¢ 


99999 FORMAT (3D26.12) MAN 82@ 

99998 FORMAT (46H DIMENSIONS TOO SMALL IN THE SUBROUTINE EXTRAP) MAN 83@ 

99997 FORMAT (42H DIVISION BY ZERO IN THE SUBROUTINE EXTRAP) MAN 846 

END MAN 85@ 

Table II 
x _L(f) L(P}?”) 

0.20000000000000D+00 0.16014316699801D+01 0.16014316699801D+01 
0.40000000000000D+00 0.24923427754674D+01 0.24923427754674D+01 
0.60000000000000D+00 0.30341791780962D+01 0.30341791780962D+01 
0.80000000000000D-+00 0.33542677046355D+01 0.33542677046355D+01 
0.10000000000000D+01 0.34695222627459D+01 0.34695222627459D+01 
0.12000000000000D+01 0.33740605363995D+01 0.33740605363995D+01 
0.14000000000000D+01 0.30580620483999D+01 0.30580620483999D-+01 
0.16000000000000D+01 0.25139875953957D+01 0.25139875953957D+01 
0.18000000000000D+01 0.17390738530797D+01 0.17390738530797D+01 
0.73634273757251D+00 0.73634273757251D+00 


0.20000000000000D+01 


Of course, L (P{) = L(f) for all x, as can be checked from the numerical results 
shown in Table II. 

The MNA-algorithm can also be used to implement another convergence 
acceleration process due to Germain-Bonne [9, pp. 33-43] that is based on 
generalized inverse interpolation. 


4. LEAST SQUARES APPROXIMATION AND EXTRAPOLATION 


Let E be an inner product space. The: least squares approximation of f € E by a 
combination of the given independent elements fo, ..., f, of E consists in 
determining do, ..., az such that 


lf — (Qofo + +++ + arfz) || 


be minimum where || - ||” = (-, -). It is well known (e.g., see [7, p. 182]) that the 
solution F, = dofo + +++ + azf, of this minimization problem is given by a ratio 
of determinants completely similar to the one defining Pf in the general 
interpolation problem; one only has to replace L;(f;) by (fi, f) and w; by (fi, f). If 
L is a linear functional on E, then the sequence (L (F;,)) can be obtained via the 
MNA algorithm with the initializations 

L(fo) 


PY = uf) 
ame era a) 


L(fo) 
(fas fo) 


on = (ha fi) — Lf). 
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We shall obtain 
P® = L(F;). 


A special case of this general problem is to find F;, which satisfies the system of 
linear equations 


Li(Fr) = wi, 


in the least squares sense. The solution of this problem can be obtained by the 
MNaA-algorithm where the scalar product is defined by 


(ha) = ¥ LA ALi a). 


i=0,...,mek 


Another special case is the biconjugate gradient method for solving systems of 
linear equations whose successive iterates are still given by a similar ratio of 
determinants [2, p. 87] and which can therefore be computed by the MNA- 
algorithm. 

The subroutine EXTRAP can be used for implementing all these least squares 
approximation problems. This subroutine can also be used for a convergence 
acceleration process due to Cordellier [6] that is based on least squares. Let us 
explain this process. 

The E-transformation of sequences described in Section 2 was obtained by 
assuming that the given sequence (S,,) satisfied 


Sn4i= St+aigi(n +1) + +++ + arge(n + 1) 


for 1=0,..., & and then solving this system for the unknown S. Cordellier’s idea 
consists of writing this system for 1 = 0,..., m= & and then solving it in the least 
squares sense for the unknown S. This least squares solution can be obtained by 
the E-algorithm as we now see. We set 


£i= (gi(n);...3;gi(n +m))", i=1 
ja 0 Ere a 
V = (Sni...3 Snam)'. 
Thus the system becomes 
, £8081) | (Bo, Be) S (go, V) 
(80, 80) ( 80, Zo) a (Zo, 80) 
l (2r, £1) ae (gz, &) Ar (ge; Vv) 
(gr, Zo) (8%, Zo) (8, £0) 


The value of S thus obtained will depend on m, k, and n, and we denote it by 
mii. Since the preceding system has the same form as the system implicitly 
solved by the E-algorithm, we can use it to obtain the sequence ,,E” for k = 0, 
..., mand n and mm fixed. In this case the initializations must be 


Em = eV) 
(En, £0) 
(En, 8i) ’ 
eee eed 
an a) 
and we shall get 
EY = ,EQ. 


If the value of n or m is modified, then the definition of the scalar product is 
also modified and all the computations have to be started again from the 
beginning. For k = m the least squares extrapolated value will be identical to the 
value obtained by the E-transformation as described in Section 2. This is also 
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Table III 

1E? EP? 
(Perturbed (Perturbed sep 
sequence and sequence and (Unperturbed 
k perturbed g;) R.E. unperturbed g;) R.E. sequence) 
0 0.4567459 1.7 0.4567459 1.7 0.4566666 
1 0.1782071 2.3 0.1782336 3.8 0.1781660 
2 0.0937578 6.4 0.0938553 4.0 0.0938178 
3 0.0581327 32.4 0.0583042 3.0 0.0583216 
4 


0.0398319 42.0 0.0398976 25.6 0.0399999 


true for the value obtained by least squares approximation that will be equal to 
the value obtained by interpolation when m = k. 

The basic advantage of least squares extrapolation is to be less sensitive to 
small perturbations in the sequence (S,,) to be accelerated. 

Let us take the same example as in Section 2 and let us add a perturbation of 
magnitude less than 10‘ to the sequence (S,). 

Since the sequences ( g;) depend on (S,,), a perturbation of (S,,) will also modify 
the (gi). Thus two different experiments have been conducted: with the (g;) 
automatically modified by the perturbation of (S,) and with unmodified (gi). 
Columns R.E. in Table III contain the values of the relative errors with respect 
to the unperturbed case multiplied by 10000. For n = 0 and m = 4 we get the 
results also shown in the table. As we can verify, the .E?”s (k < 4) are less 
sensitive to the perturbation than ,E{” = E{° = 0.04. It must be noticed that the 
results obtained are very sensitive to the precision on the computation of the 
scalar products appearing in the initializations. 
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1. INTRODUCTION 


ITPACK 2C is a collection of seven FORTRAN subroutines for solving large 
sparse linear systems by adaptive accelerated iterative algorithms. Basic iterative 
procedures, such as the Jacobi method, the successive overrelaxation method, 
the symmetric successive overrelaxation method, and the RS method for the 
reduced system are combined, where possible, with acceleration procedures, such 
as Chebyshev (semi-iteration) and conjugate gradient, for rapid convergence. 
Automatic selection of the acceleration parameters and the use of accurate 
stopping criteria are major features of this software package. While the ITPACK 
routines can be called with any linear system containing positive diagonal 
elements, they are the most successful in solving systems with symmetric positive 
definite or mildly nonsymmetric coefficient matrices. 

For several years, we have been involved with the development and use of 
research-oriented programs using iterative algorithms for solving large sparse 


Au=b 


with positive diagonal elements. One solves for the N component unknown vector 
u given the N X N nonsingular coefficient matrix A and the N component right- 
hand side vector b. The current ITPACK software package of subroutines, version 
2C, provides for the use of seven alternative iterative procedures. While these 
subroutines are not designed as production software, they should successfully 
handle industrial problems of moderate size, that is, ones that fit in high-speed 
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memory. This package is written in 1966 American National Standard FOR- 
TRAN code. It has been tested over a wide variety of computer systems using 
various FORTRAN compilers, including one which is FORTRAN-77 compatible 
(see Acknowledgments). 

The seven iterative solution modules are based on several basic iterative 
procedures, such as the Jacobi method, the successive overrelaxation (SOR) 
method, the symmetric SOR (SSOR) method, and the RS method for the reduced 
system. With the exception of SOR, the convergence of these basic methods are 
accelerated by Chebyshev (semi-iteration, SI) or conjugate gradient (CG) accel- 
eration. All methods are available with adaptive parameter estimation and 
automatic stopping tests. When using the RS method it is required that the linear 
system be reordered into a “red-black” system [6, 13].’ A switch to compute, if 
possible, the red-black indexing, permute the linear system, and permute asso- 
ciated vectors is provided. 

The successful convergence of iterative methods rnay be dependent on condi- 
tions that are difficult to determine in advance. For example, determining whether 
the coefficient matrix is positive definite can be as costly to check as solving the 
system. On the other hand, some conditions affecting convergence, such as 
positive diagonal elements, diagonal dominance, and symmetry are relatively 
easy to verify. For some applications, the theory to guarantee the convergence of 
an iterative method may not exist. The algorithms in ITPACK have been tested 
most extensively for linear systems arising from elliptic partial differential equa- 
tions. The routines can be applied formally to any linear system which fits in 
high-speed memory. However, rapid convergence, and indeed convergence itself 
cannot be guaranteed unless the matrix of the system is symmetric and positive 
definite. Success can be expected, though not guaranteed, for mildly nonsymmet- 
ric systems. In other words, iterative methods may not converge when applied to 
systems with coefficient matrices which are completely general with no special 
properties. 

This article discusses the usage of ITPACK and gives a few test results. The 
description of the iterative methods is given in [4]. The underlying theory on 
which the iterative algorithms are based is described in [6]. A survey of the 
iterative methods in ITPACK is presented in [12]. 

Throughout this paper, we adopt notation such as SOR() when referring to a 
subroutine and A(*) for a single-dimensioned array. The residual vector is b — 
Au for the linear system Au = 6 and the pseudo-residual vector is Gu” + k — 
u” for a basic iterative method of the form u'"*) = Gu™ + k. The smallest and 
largest eigenvalues of the iteration matrix G are denoted m(G) and M(G), 
respectively. 


2. SPARSE MATRIX STORAGE 


The sparse storage scheme used in ITPACK is a common one. It is a row-wise 
representation of the nonzero entries in the coefficient matrix of the linear system. 
For a nonsymmetric coefficient matrix, all of the nonzero values in each row are 
stored in a contiguous block of data in a real-valued array A(*). If the matrix is 
symmetric, computer memory can be saved by storing only the nonzero entries 
in each row on and above the main diagonal. For either nonsymmetric or 
symmetric sparse storage, associated column numbers are stored in an integer- 
valued array JA(*) such that JA(K) is the column number for the value A(K). 


"In this ordering, the components of the unknown vector u are considered as either “red” or “black”. 
A “red-black ordering” is any ordering such that every black unknown follows all of the red unknowns. 
This ordering of unknowns leads to a 2 x 2 “red-black partitioning” of the coefficient matrix; that is, 


a matrix of the form 
Ai Ale 
Az: Azz 


with diagonal submatrices Ai; and A2»2. The original linear system may require rearrangement in 
order to arrive at this form. 
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A mapping vector [A(*) is used to denote the starting locations of each of the 

contiguous blocks. The beginning of the linear block for row I is given by IA()), 

the end by IA(I + 1) — 1, and its length by IACI + 1) — IAQ). Thus, TA(*) will 

contain N + 1 elements to accommodate a linear system of order N. The entries 

for each row may be stored in any order in the contiguous block for that row. 
For example, the coefficient matrix 


ll. O. O. 14. 15. 
0. 22. 0 O 20. 
0 oO 33 O. 0. 

14. 0. OO. 44. 46. 

15. 0 OO. 465. 565. 


would be represented in nonsymmetric sparse storage as 
A(*) = [11., 14., 15., 22., 33., 14., 44., 45., 15., 45., 55.] 
JA(*) = [1, 4, 5, 2, 3, 1, 4, 5, 1, 4, 5] 
IA(*) = [1, 4, 5, 6, 9, 12] 
and in symmetric sparse storage as 
A(*) = [11., 14., 15., 22., 33., 44., 45., 55.] 
JA(*) = [1, 4, 5, 2, 3, 4, 5, 5] 
IA(*) = [1, 4, 5, 6, 8, 9] 


3. USAGE 


The user is expected to provide the coefficient matrix and the right-hand side of 
the linear system to be solved. The data structure for the matrix of the system is 
either the symmetric or nonsymmetric sparse storage format described in the 
previous section. An initial guess for the solution should be provided, if one is 
known; otherwise, it can be set to all zero values. A series of approximations for 
the solution are generated iteratively until the convergence criterion is satisfied. 
The algorithms are performed in two work-space arrays and some control over 
the algorithmic procedure can be obtained from switches in two parameter arrays. 

There are seven main subroutines in ITPACK, each corresponding to an 
iterative method. They are 


SUBROUTINE METHOD 

JCG() Jacobi Conjugate Gradient 

JSI() Jacobi Semi-iteration 

SOR() Successive Overrelaxation 
SSORCG( ) Symmetric SOR Conjugate Gradient 
SSORSI() Symmetric SOR Semi-iteration 
RSCG() Reduced System Conjugate Gradient 
RSSI() Reduced System Semi-iteration 


and the calling sequence is 


CALL (method) (N, IA, JA, A, RHS, U, IWKSP, NW, WKSP, IPARM, 
RPARM, IER) 


where the parameters are defined in the following. Here “input” means that the 
subroutine expects the user to provide the necessary input data, and “output” 
means that the routine passes back information in the variable or array indicated. 
All parameters are linear arrays, except variables N, NW, and IER. Moreover, all 
parameters may be altered by the subroutine call, except variables N and NW. 
(See Section 7 for additional details.) 
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PARAMETER, 


DESCRIPTION 


N 
TA(*) 


JA(*) 


A(*) 


RHS(*) 


UM) 


IWKSP(*) 


NW 


WKSP(*) 


IPARM(*) 


RPARM(*) 


IER 


Order of the linear system. [integer; input] 

Vector of length N + 1 used in the sparse-matrix storage format. 
Contains the row pointers into JA(*) and A(*). [integer array; 
input] 

Vector of length NZ (defined in A(*) below) used in the sparse- 
matrix storage format. Contains the column numbers for the 
corresponding entries in A(*). [integer array; input | 

Vector of length NZ used in the sparse-matrix storage format. 
Contains the nonzero entries of the coefficient matrix with 
positive diagonal elements. (NZ is the number of nonzero entries 
in the upper triangular part of the coefficient matrix when 
symmetric storage is used and is the total number of nonzeros 
when nonsymmetric storage is used.) [real array; input] 

Vector of length N containing the right-hand side of the linear 
system. [real array; input] 

Vector of length N containing the initial guess to the solution of 
the linear system on input and the latest approximate solution 
on output. [real array; input/output] 

Vector of length 3*N used for integer work space. When rein- 
dexing for red-black ordering, the first N locations contain on 
output the permutation vector for the red-black indexing, the 
next N locations contain its inverse, and the last N are used for 
integer work space.” [integer array; output] 

On input, NW is the available length for WKSP(*). On output, 
IPARM(8) is the actual amount used (or needed). [integer; 
input | 

Vector used for real working space whose length depends on the 
iterative method being used. Must be at least NW entries long. 
(See table near end of this section for required amount of work 
space for each method.) [real array] 


Vector of length 12 used to initialize various integer and logical 
parameters. Default values may be set by calling subroutine 
DFAULT() described below. On output, IPARM(*) contains 
the values of the parameters that were changed. (Further details 
to follow.) [integer array; input/output | 

Vector of length 12 used to initialize various real parameters on 
input. Default values may be set by calling subroutine 
DFAULT() described below. On output, RPARM(*) contains 
the final values of the parameters that were changed. (Further 
details given later in this section.) |real array; input/output] 
Error flag which is set to zero for normal convergence and to a 
nonzero integer when an error condition is present. (See table at 
end of section for meaning of nonzero values.) [integer; output] 


The user may supply nondefault values for selected quantities in IPARM(*) 
and RPARM(*) by first executing 


CALL DFAULT (IPARM, RPARM) 


and then assigning the appropriate nondefault values before calling a solution 
module of ITPACK. 


? For the red-black ordering, the Ith entry of a permutation array P() indicates the position J into 
which the Ith unknown of the original system is being mapped; that is, if P(I) = J, then unknown I 
is mapped into position J. The Jth entry of an inverse permutation array IP() indicates the position 
T into which the Jth unknown of the permuted system must be mapped to regain the original ordering, 


that is, IP(J) = I. 
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The iterative algorithms used in ITPACK are quite complicated and some 
knowledge of iterative methods is necessary to completely understand them. The 
interested reader should consult [4] and [6] for details. Important variables in 
this package which may change adaptively are CME (estimate of largest eigen- 
value of the Jacobi matrix), SME (estimate of the smallest eigenvalue of the 
Jacobi matrix), OMEGA (overrelaxation parameter for the SOR and SSOR 
methods), SPECR (estimate of the spectral radius of the SSOR matrix), BETAB 
(estimate for the spectral radius of the matrix LU, where L and U are strictly 
lower and upper triangular matrices, respectively, such that the Jacobi matrix B 
=L+U). 

The integer array IPARM(*) and real array RPARM(*) allow the user to 
control certain parameters which affect the performance of the iterative algori- 
thms. Furthermore, these arrays allow the updated parameters from the auto- 
matic adaptive procedures to be communicated back to the user. The entries in 
IPARM(*) and RPARM(*) are 


POSITION DEFAULT MEANING OR USAGE ___ 


IPARM(1) 100 ITMAX: Maximum number of iterations al- 
lowed. Reset on output to the number of 
iterations performed. 


IPARM() 0 LEVEL: Control level of output. Each higher 
value provides additional information. 


[<0: no output on unit IPARM(4); 

: fatal error messages only; 

: warning messages and minimum output; 

: reasonable summary (progress of algorithm); 

: parameter values and informative comments; 

: approximate solution after each iteration 
(primarily useful for debugging); 

5: original system] 


IPARM(3) 0 IRESET: Communication switch. 


[0: implies certain values of IPARM(*) and 
RPARM(*) will be overwritten to communi- 
cate parameters back to the user; 

otherwise: only IPARM(1) and IPARM(8) will 


Bm wN e& © 


be reset. | 
IPARM(4) 6 NOUT: output unit number. 
IPARM(5) 0 ISYM: Sparse-storage format switch. 


[0: symmetric sparse storage; 
1: nonsymmetric sparse storage] 


IPARM(6) 1 IADAPT: Adaptive switch. Determines 
whether certain parameters have been set by 
user or should be computed automatically in 
either a fully or partially adaptive sense. 


[0: fixed iterative parameters used for 
SME, CME, OMEGA, SPECR, and BETAB 
(nonadaptive); 

1: fully adaptive procedures used for all parame- 
ters; 

2:(SSOR methods only) SPECR determined 
adaptively and CME, BETAB, and OMEGA 
fixed; 

3: (SSOR methods only) BETAB fixed and all 
other parameters determined adaptively] 


(See [4, 6] for details and RPARM(D, I = 2, 


3, 5, 6, 7, for CME, SME, OMEGA, SPECR, 
BETAB, respectively. These parameters are 
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IPARM(7) 


IPARM(8) 


IPARM(9) 


1 


set by subroutine DFAULT() or by the 
user.) 

ICASE: Adaptive procedure case switch for 
JSI and SSOR methods. There are two strat- 
egies, called Case I and Case II, for doing the 
adaptive procedure. The choice of which case 
to select corresponds to knowledge of the 
eigenvalues of the Jacobi matrix B and their 
estimates. 

[ (¥ 2) Case I: fixed SME < m(B) (general case); 


(= 2) Case II: use when it is known that | m(B) | 
< M(B)] 


The case switch determines how the esti- 
mates for SME and CME are recomputed 
adaptively. In Case I, SME is fixed through- 
out and should be less than or equal to m(B). 
In Case II, SME is set to -CME, which may 
adaptively change. As far as the adaptive 
procedure is concerned, Case I is the most 
general case and should be specified in the 
absence of specific knowledge of the relation- 
ship between the eigenvalues and their esti- 
mates. An example when Case II is appropri- 
ate occurs when the Jacobi matrix has Prop- 
erty A, since m(B) = —M(B).* Also, if A is 
an L-matrix, then for the Jacobi matrix, we 
have |m(B)| = M(B) and SME is always 
—CME (Case II).* Selecting the correct case 
may increase the rate of convergence of the 
iterative method. (See [6] for additional dis- 
cussion on Cases I and II. Also, see 
RPARM(D), I = 2, 3 for CME, SME, respec- 
tively.) 
NWKSP: Amount of work space used. Used 
for output only. If ITMAX is set to a value 
just over the actual number of iterations nec- 
essary for convergence, the amount of mem- 
ory for WKSP(*) can be reduced to just over 
the value returned here. This may be done 
when rerunning a problem, for example. 
NB: Red-black ordering switch. On output, 
if reindexing is clone, NB is set to the order of 
the black subsystem. 
[For RS methods, 
<0: compute red--black indexing and permute sys- 
tem; 
20: skip indexing—system already in red-black 
form; 
For other methods, 
<0: skip indexing—system already in desired 
form; 
=0: compute red--black indexing and permute sys- 
tem | 


* A matrix has Property A if and only if it is a diagonal matrix, or else there exists a rearrangement of 
the rows and corresponding columns of the matrix which corresponds to a red-black partitioning. 
* An L-matrix has positive diagonal elements and nonpositive off-diagonal elements. 
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IPARM(10) 


IPARM(11) 


IPARM(12) 


ENTRY 
DEFAULT 


RPARM(1) 5.E-6 


RPARM(2) 0. 


RPARM(3) 0. 


A negative integer value for IPARM(9) 
causes the equations to be handled in the 
most general way appropriate for the solution 
method being used. For methods other than 
RS methods this is the “natural order,” while 
for RS methods it is the “red-black order.” A 
nonnegative value produces a red-black per- 
mutation for all methods except for the RS 
methods, which are assumed to be in red- 
black order with the order of the black sub- 
system NB given. If reindexing is performed, 
IPARM(9) will contain the order of the black 
subsystem on output. 

0 IREMOVE: Switch for effectively removing 
rows and columns when the diagonal entry is 
extremely large compared to the nonzero off- 
diagonal entries in that row. (See RPARM(8) 
for additional details.) 


[0: not done; otherwise: test done] 


0 ITIME: Timing switch. 
[0: time method; otherwise: not done] 

0 IDGTS: Error analysis switch. An analysis of 
final computed solution to determine accu- 
racy. 


[<0: skip error analysis 

0: compute DIGIT1 and DIGIT2 and store 
in RPARM(), I = 11, 12, respectively; 

1: print DIGIT1 and DIGIT2; 

2: print final approximate solution vector; 

3: print final approximate residual vector; 

_4: print both solution and residual vectors; 
otherwise: no printing | 


(if LEVEL < 0, no printing is done. See 
RPARM(), I = 11, 12, for details on 
DIGIT1 and DIGIT2.) 


DESCRIPTION - 


ZETA: Stopping criterion or approximate relative accu- 
racy desired in the final computer solution. If the method 
does not converge in IPARM(1) iterations, RPARM(1) is 
reset to an estimate of the relative accuracy achieved. 
The stopping criterion is a test of whether ZETA is 
greater than the ratio of the Euclidean norm of the 
pseudo-residual vector and the norm of the current iter- 
ation vector times a constant involving an eigenvalue 
estimate. (See [4, 6] for details.) 


CME: Estimate of largest eigenvalue of Jacobi matrix. 
Changes to new estimate if adaptive procedure is used. 
CME = M(B). 

SME: Estimate of smallest eigenvalue of Jacobi matrix 
for JSI method. In Case I, SME is fixed throughout at a 
value = m(B). In Case II, SME is always set to -CME 
with CME changing in the adaptive procedure. (See 
IPARM(7) for definitions of Cases I and II.) 
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RPARM(4) .75 
RPARM(5) 1. 


RPARM(6) 0. 


RPARM(7) .25 


RPARM(8) 
100. « SRELPR 


RPARM(9) 0. 


RPARM(10) 0. 
RPARM(11) 0. 


RPARM(12) 0. 


FF: Adaptive procedure damping factor. Values in the 
interval (0., 1.] with 1. causing the most frequent param- 
eter changes when the fully adaptive switch IPARM(6) 
= 1 is used. 

OMEGA: Overrelaxation parameter for SOR and SSOR 
methods. If method is fully adaptive, OMEGA changes. 
SPECR: Estimated spectral radius for SSOR matrix. If 
method is adaptive, SPECR changes. 


BETAB: Estimate for the spectral radius of matrix LU 
used in SSOR methods. BETAB may change depending 
on the adaptive switch IPARM(6). The matrix L is the 
strictly lower triangular part of the Jacobi matrix and U 
the strictly upper triangular part. When the spectral ra- 
dius of LU is less than or equal to 4, the “SSOR condition” 
is satisfied for some problems, provided one uses the 
natural ordering. (See [4, 5, 19] for additional details.) 
TOL: Tolerance factor near machine relative precision, 
SRELPR. In each row, if all nonzero off-diagonal row 
entries are less than TOL tirnes the value of the diagonal 
entry, then this row and corresponding column are essen- 
tially removed from the system. This is done by setting 
the nonzero off-diagonal elements in the row and corre- 
sponding column to zero, replacing the diagonal element 
with 1, and adjusting the elements on the right-hand side 
of the system so that the new system is equivalent to the 
original one.” If the diagonal entry is the only nonzero 
element in a row and is not greater than the reciprocal of 
TOL, then no elimination is done. This procedure is useful 
for linear systems arising from finite-element discretiza- 
tions of PDEs in which Dirichlet boundary conditions are 
handled by giving the diagonal values in the linear system 
extremely large values. (The installer of this package 
should set the value of SRELPR. See comments in sub- 
routine DFAULT( ) for additional details.) 


TIME1: Total time in seconds from beginning of iterative 
algorithm until convergence. (A machine-dependent sub- 
program call for returning the time in seconds is provided 
by the installer of this package.) 

TIME2: Total time in seconds for entire call. 

DIGIT1: Approximate number of digits using the esti- 
mated relative error with the final approximate solution. 
Computed as the negative of the logarithm base 10 of 
the final value of the stopping test. (See details below 
or [6].) 

DIGIT2: Approximate number of digits using the esti- 
mated relative residual with the final approximate solu- 
tion. Computed as the negative of the logarithm base 10 
of the ratio of the two norm of the residual vector and the 
two norm of the right-hand-side vector. This estimate is 
related to the condition number of the original linear 
system and therefore it will not be accurate if the system 
is ill-conditioned. (See details below or [6].) 


° If the row and column corresponding to diagonal entry coef(i, i) are to be eliminated, then the right- 
hand side is adjusted to rhs(z) = rhs(t)/coef (i, 1) and rhs(7) = rhs(7) — rhs(i) coef (i, 7) for 7 # t. 
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DIGIT1 is determined from the actual stopping test computed on the final 
iteration, whereas DIGIT2 is based on the computed residual vector using the 
final approximate solution after the algorithm has converged. If these values 
differ greatly, then either the stopping test has not worked successfully or the 
original system is ill-conditioned. (See [6] for additional details.) 

For storage of certain intermediate results, the solution modules require a real 
vector WKSP(*) and a corresponding variable NW indicating the available 
space. The length of the work-space array varies with each solution module and 
the maximum amount needed is given in the following table. 


SOLUTION MODULE MAXIMUM LENGTH OF WKSP(*) 


JICG() 4*N+NCG 

JSI() 2«N 

SOR() N 

SSORCG() 6*N+NCG 
SSORSI() 5*«N . 

RSCG() N+3+*NB+NCG 
RSSI() N + NB 


where value of NCG is 2 *IPARM(1) for symmetric sparse storage and 
4 « IPARM(1) for nonsymmetric sparse storage. It should be noted that the 
actual amount of work space used may be somewhat less than these upper limits 
since some of the latter are dependent on the maximum number of iterations 
allowed, ITMAX, stored in IPARM(1). Clearly, the array WKSP(*) must be 
dimensioned to at least the value of NW. 

Nonzero integer values of the error flag TER indicate that an error condition 
was detected. These values are listed below according to their numerical value 
and to the name of the routine in which the flag was set. 


ERROR FLAG MEANING 


IER = 0, Normal convergence obtained. 
= 1+ Mth, Invalid order of system, N 
= 2+ Mth, Work-space array WKSP(*) not large enough—IPARM(8) 
set to amount of required work space, NW. 
3 + Mth, Failure to converge in IPARM(1) iterations—RPARM(1) 
reset to last stopping value computed. 
= 4+ Mth, Invalid order of black subsystem, NB. 


= 101, Diagonal element not positive. 

= 102, No diagonal entry in a row. 

= 201, Red-black indexing not possible. 

= 301, No entry in row of original matrix. — 

= 302, No entry in row of permuted matrix. 

= 303, Sorting error in row of permuted matrix. 

= 401, Diagonal element not positive. 

= 402, No diagonal entry in a row. 

= 501, Failure to converge in ITMAX evaluations. 
= 502, Function does not change sign at endpoints. 
= 601, Successive iterates not monotone increasing. 


JCG(), JSI(), SOR( ), SSORCG( ), SSORSI( ), RSCG(), RSSI( ) assign values 
to Mth of 10, 20, 30, 40, 50, 60, 70, respectively. SBELM(), PRBNDX(), 
PERMAT(), SCAL( ), ZBRENT(), EQRT1S() are subroutines with error flags 
in the 100s, 200s, 300s, 400s, 500s, 600s, respectively. These routines perform the 
following functions: SBELM() removes rows and columns, PRBNDX( ) deter- 
mines the red-black indexing, SCAL() scales the system, ZBRENT() is a 
modified IMSL routine for computing a zero of a function which changes sign in 
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a given interval, EQRT1S( ) is a modified IMSL routine for computing the largest 
eigenvalue of a symmetric tridiagonal matrix.® 


4. USER-ORIENTED MODULES 


The array U(*) should contain an initial approximation to the solution of the 
linear system before any ITPACK module is called. If the user has no information 
for making such a guess, then the zero vector may be used as the starting vector. 
The subroutine VFILL( ) can be used to fill a vector with a constant: 


CALL VFILL (N, U, VAL) 


fills array U(*) of length N with value VAL in each entry. 
To aid the user in using the iterative methods of ITPACK, four modules for 
constructing the sparse-matrix storage arrays are included. The modules are 


SBINI( ) called at the beginning to initialize the arrays IA(*), JA(*), A(*), 
and WORK (*); 

SBSIJ() called repeatedly to set the individual entries in the matrix and 
build a link-list representation of the rnatrix structure; 

SBEND() called at the end to restructure the link list into final sparse storage 
form; 

SBAGN() called to return again to the link-list representation if SBEND() 
has been called but additional elements are to be added or modified. 


These modules are described below. 
(a) Initialization: 
CALL SBINI (N, NZ, IA, JA, A, WORK) 


Initializes LA(*), JA(*), A(*), and IWORK(*) for a system of order N. IA(*), 
JA(*), and IWORK(*) are integer arrays of length at least N + 1, NZ, and NZ, 
respectively. A(*) is a real array of length at least NZ. 

(b) Set individual entries: 


CALL SBSIJ (N, NZ, 1A, JA, A, WORK, I, J, VAL, MODE, LEVEL, NOUT, 
IER) 


Inserts the value, VAL, of the (I, J) entry of the user’s matrix into the link-list 
representation for that matrix. When using symmetric sparse storage, J must be 
greater than or equal to I. If the (I, J) entry has already been set, then MODE 
specifies the way in which the entry is to be treated: 


MODE <0, Current entry value is left as is; 
=Q, Current entry value is reset to VAL; 
>0, VAL is added to the current entry value. 


If LEVEL is less than 0, SBSIJ() causes no printing. If LEVEL is 0, fatal error 
messages are written to output unit number NOUT; and if LEVEL is 1 or greater, 
a message is printed when SBSIJ() encounters a value it has already set with 
the value being reset according to the value of MODE. IER is an error parameter 
and returns values of 


ERROR FLAG MEANING 

IER = “0, New (I, J) entry established. 
= 700, (I, J) entry already set—reset according to MODE. 
= 701, Improper values for either I or J. 
= 702, NZ too small—no room for new entry. 


* International Mathematical and Statistical Libraries, Inc., Sixth Floor NBC Bldg., 7500 Bellaire 
Blvd., Houston, TX 77036. 
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(c) Finalization: 
CALL SBEND (N, NZ, IA, JA, A, TWORK) 


Restructures the link-list data structure built by SBINI() and SBSIJ() into the 
final data structure required by ITPACK. 
(d) Undo finalization: 


CALL SBAGN (N, NZ, IA, JA, A, WORK, LEVEL, NOUT, IER) 


Returns to link-list representation for modification or addition of elements to the 
system. Repeated calls to SBSIJ() can then be made followed by a single call to 
SBEND() to close out the sparse-matrix representation. If LEVEL is less than 
0, no printing is done, and if LEVEL is 0 or greater, fatal error information is 
written to output unit number NOUT. IER is an error flag indicating 


ERROR FLAG MEANING 
IER = 0, Successful completion. 
= 708, NZ too small—no room for new entry. 


Note that SBINI() should not be called after SBAGN() is called, since it would 
destroy the previous data. 


5. EXAMPLES 
Given a linear system Au = 6 with 
4 -1 -1 0 6 
-l1 4 90 -1 0 
AV 2. et YO 
0 -l1 -1 4 6 


a program to solve this problem with an initial guess of u’ = (0, 0, 0, 0) using 
JCG() with symmetric sparse storage and printing the final approximate solution 
vector follows. 


INTEGER IA(5), JA(8), IPARM(12), IWKSP(12) 

REAL A(8), RHS(4), U(4), WKSP(24), RPARM(12) 

DATA A(1), A(2), A(3), A(4)/4.0, —1.0, —1.0, 4.0/ 

DATA A(5), A(6), A(7), A(8)/—1.0, 4.0, ~1.0, 4.0/ 

DATA JA(1), JA(2), JA(3), JA(4)/1, 2, 3, 2/ 

DATA JA(5), JA(6), JA(7), JA(8)/4, 3, 4, 4/ 

DATA IA(1), IA(2), LA(3), TA(4), LA(5)/1, 4, 6, 8, 9/ 
DATA RHS(1), RHS(2), RHS(3), RHS(4)/6.0, 0.0, 0.0, 6.0/ 
DATA N/4/, NW/24/, ITMAX/4/, LEVEL/1/, IDGTS/2/ 


CALL DFAULT (IPARM, RPARM) 
IPARM(1) = ITMAX 

IPARM(2) = LEVEL 

IPARM(12) = IDGTS 

CALL VFILL (N, U, 0.E0) 

CALL JCG (N, IA, JA, A, RHS, U, IWKSP, NW, WKSP, IPARM, RPARM, IER) 
STOP 

END 


The output for this run would be 


BEGINNING OF ITPACK SOLUTION MODULE JCG 
JCG HAS CONVERGED IN 2 ITERATIONS. 
APPROX. NO. OF DIGITS (EST. REL. ERROR) = 14.6 (DIGIT1) 
APPROX. NO. OF DIGITS (EST. REL. RESIDUAL) = 14.3 (DIGIT2) 
SOLUTION VECTOR. 


2.00000E+00 1.00000E+00 1.00000E+00 2.00000E+00 


Textbook methods such as the Jacobi (J), Gauss-Seidel (GS), successive 
overrelaxation (SOR—fixed relaxation factor omega), symmetric successive 
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Table I 
Method Use Parameters 
J JSI() IPARM(6) = 0, IPARM(7) = 2 
GS SOR() IPARM(6) = 0 
SOR—fixed omega SOR() IPARM(6) = 0, RPARM(5) = OMEGA 
SSOR—fixed omega SSORSI() IPARM(6) = 0, RPARM(5) = OMEGA 
RS RSSI( ) IPARM(6) = 0 


overrelaxation (SSOR—fixed relaxation factor omega), and the RS method can 
be obtained from this package by resetting appropriate parameters after the 
subroutine DFAULT() is called but before ITPACK routines are called (see 
Table I). These methods were not included as separate routines because they are 
usually slower than the accelerated methods included in this package. 

On the black unknowns, the cyclic Chebyshev semi-iterative (CCSI) method of 
Golub and Varga [2] gives the same result as the RSSI method. The CCSI and 
RSSI methods converge at the same rate, and each of them converges twice as 
fast as the JSI method. This is a theoretical result [6] and does not count the 
time involved in establishing the red-black indexing and the red-black partitioned 
system. Similarly, the cyclic conjugate gradient (CCG) method with respect to 
the black unknowns, considered by Reid [16] (see also Hageman and Young 
[6]), gives the same results as the RSCG method. Also, the CCG and the RSCG 
methods converge at the same rate, and each of them converges, theoretically, 
exactly twice as fast as the JCG method. Hence, the accelerated RS methods are 
preferable to the accelerated J methods when using a red-black indexing. 


6. NUMERICAL RESULTS 


The iterative algorithms in ITPACK have been tested over a wide class of matrix 
problems arising from elliptic partial differential equations with Dirichlet, Neu- 
mann, and mixed boundary conditions on arbitrary two-dimensional regions 
(including cracks and holes) and on rectangular three-dimensional regions [1]. 
Both finite-difference and finite-element procedures have been employed to 
obtain the linear systems. The two sample problems presented here, while simple 
to pose, are representative of the behavior of the ITPACK routines for more 
complex problems. The iterative algorithms make no use of the constant coeffi- 
cients in these two problems or of the particular structure of the resulting linear 
system. Because the ITPACK code is not tailored to any particular class of 
partial differential equations or discretization procedure, but rather to sparse 
linear systems, it is felt that the package can be used to solve a wider class of 
problems. 

We now consider two simple partial differential equations that, when discretized 
by finite-difference methods, give rise to large sparse linear systems. We obtain 
the solution of each of these systems by the seven algorithms in ITPACK 2C. 
These numerical results should aid the user of ITPACK in determining the 
amount of time required when solving more complicated sparse systems. How- 
ever, one should not interpret these execution times as conclusive by themselves. 
Variances introduced by different compilers, computer systems, and timing 
functions can sometimes be significant. Moreover, the number of iterations 
required by an iterative method is dependent on the problem being solved, the 
initial estimate for the solution, the parameter estimates used, and the relative 
accuracy requested in the stopping criterion RPARM{(1). These tests were run 
on the CDC CYBER 170/750 at the University of Texas with the FTN 4.8 
compiler (OPT = 2). 

To obtain representative sparse linear systems, we discretize the following two 
self-adjoint elliptic partial differential equations in a region with prescribed 
conditions on the boundary. Here u;x, Uyy, Uzz are partial derivatives and du/dn 
is the derivative in the normal direction. 
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Table II. Number of Iterations and Execution Times for Problem (1) Using Adaptive and 
Nonadaptive Procedures (Nonadaptive Data in Parentheses) 
Routine Ordering Iterations Iteration time Total time 
JICG() Natural 61 (61) 0.250 (0.247) 0.281 (0.271) 
Red-black 61 (61) 0.232 (0.246) 0.402 (0.413) 
JSI() Natural 108 (95) 0.408 (0.344) 0.439 (0.375) 
Red-black 108 (95) 0.393 (0.332) 0.569 (0.498) 
SOR() Natural 72 (54) 0.356 (0.280) 0.368 (0.307) 
’ Red-black 65 (47) 0.311 (0.224) 0.469 (0.411) 
SSORCG() Natural 17 (13) 0.232 (0.173) 0.264 (0.185) 
SSORSI() Natural 23 (22) 0.242 (0.213) 0.273 (0.244) 
RSCG() Red-black 31 (31) 0.104 (0.117) 0.269 (0.297) 
RSSI() Red-black 60 (48) 0.207 (0.166) 0.358 (0.344) 
Table III. Number of Iterations and Execution Times for Problem (2) Using Adaptive and 
Nonadaptive Procedures (Nonadaptive Data in Parentheses) 
Routine Ordering Iterations Iteration time Total time 
JICG() Natural 28 (28) 0.092 (0.090) 0.107 (0.090) 
Red-black 28 (28) 0.079 (0.074) 0.191 (0.202) 
JSI() Natural 64 (54) 0.166 (0.136) 0.196 (0.152) 
Red-black 64 (54) 0.160 (0.130) 0.268 (0.266) 
SOR() Natural 42 (29) 0.139 (0.095) 0.150 (0.110) 
Red-black 38 (29) 0.124 (0.097) 0.236 (0.231) 
SSORCG() Natural 15 (11) 0.136 (0.097) 0.167 (0.111) 
SSORSI() Natural 19 (15) 0.138 (0.101) 0.153 (0.117) 
RSCG() Red-black 15 (15) 0.032 (0.051) 0.150 (0.169) 
RSSI() Red-black 31 (27) 0.075 (0.064) 0.186 (0.196) 
Uxx + Qyy = 0, (x,y) in S=(0,1) x (0,1) (1) 
= 1+ xy, | (x,y) on boundary of S. 
Using the standard 5-point symmetric finite-difference operator with h = 3, we 
obtain a sparse linear system with 1729 nonzero elements and 361 unknowns. 
Uxx + Quy + 3uz2 = O, (x,y,z) in C= (0,1) x (0,1) x (0, 1) 
On boundary of C: (2) 
u=1, (0, 2), (x, 0,2), or (x,y, 0) 
ye(1 + yz), (1, y, 2) 
cn = 4 xz(1 + xz), (x, 1, z) 
xy(1+ xy), (x,y, 1). 


Using the standard 7-point symmetric finite difference operator with h = 3, we 
obtain a sparse linear system with 1296 nonzero elements and 216 unknowns. 

Tables II and III display the number of iterations and execution times (in 
seconds) for the seven methods in ITPACK 2C for the linear systems correspond- 
ing to problems (1) and (2), respectively, using symmetric sparse storage. Both 
the time for the iteration algorithm and the total time for the subroutine call are 
given. The stopping criterion was set to 5.0E—6. To illustrate how effective the 
adaptive procedures are, we have included in these tables the number of iterations 
and the time when the optimum iteration parameters were used with no adaptive 
procedures. 

Values corresponding to the red—black ordering with the SSOR methods are 
omitted from the tables since it is known that these methods are ineffective with 
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this ordering. Since the RS methods are defined for only the red-black ordering, 
the table entries for these methods with the natural ordering are not included. 


7. NOTES ON USE 


Before an iterative algorithm is called to solve a linear system, the values in the 
array A(*) are permuted and scaled. Afterward, these values are unpermuted 
and unscaled. Consequently, the values in arrays A(*) and RHS(*) may change 
slightly due to round-off errors in the computer arithmetic. Moreover, since 
entries in each row of the linear system may be stored in any order within a 
contiguous block of data, the locations of elements of A(*) and of corresponding 
ones in JA(*) may change from those given before the permuting and unper- 
muting was done. The same linear system is defined by the arrays A(*), JA(*), 
and IA(*), whether or not corresponding elements in A(*) and JA(*) have 
changed locations within contiguous blocks. 

Scaling of the linear system is done as follows to reduce the number of 
arithmetic operations. The diagonal entries of the linear system are checked for 
positivity and are moved to the first N locations of the array A(*). The nonzero 
off-diagonal entries of the linear system Au = b are scaled. The scaling involves 
the diagonal matrix D’”” of square roots of the diagonal entries of the linear 
system, that is, 


(D?AD~*/?) (D'*u) = (D~*”*d). 


The algorithms iterate until convergence is reached based on the relative accuracy 
requested via the stopping criterion set in RPARM(1) for the scaled solution 
vector (D'”"u). Unscaling solves for u and returns the linear system to its original 
form subject to round-off errors in the arithmetic and to possible movement of 
entries within contiguous blocks of data. 

When requested, a red-black permutation of the data will be done before and 
after the iterative algorithm is called. Otherwise, the linear system is used in the 
order it is given, which we call the “natural ordering.” 

The successive overrelaxation (SOR) method has been shown to be more 
effective with the red-black ordering than with the natural ordering for some 
problems [19]. In the SOR algorithm, the first iteration uses OMEGA = 1.0 and 
the stopping criterion is set to a large value so that at least one Gauss-Seidel 
iteration is performed before an approximate value for the optimum relaxation 
parameter is computed. 

Optional features of this package are red—-black ordering, effective removal 
of rows and columns when the diagonal entry is extremely large, and error anal- 
ysis. In the event that one is not using some of these options and needs addi- 
tional memory space for a very large linear system, the relevant subroutines that 
can be replaced with dummy subroutines are as follows: red-black order- 
ing [PRBNDX(), PERMAT(), PERVEC(), QSORT()], removal of rows 
[SBELM( )] , error analysis [PERROR( )]. 

The timing routines ITICK( ) and ITOCK( ) should call a local system routine 
so that they return the run time in milliseconds. ITICK() is called at the 
beginning of a timing interval and ITOCK( ) at the end. 

The value of the machine relative precision is contained in the variable 
SRELPR, which is set in the subroutine DFAULT() and in the test program. 
This and other default values may be permanently changed when the code is 
installed by changing their values in the subroutine DFAULT(). SRELPR must 
be changed when moving the code to another computer. If the installer of this 
package does not know its value, an approximate value can be determined from 
a simple FORTRAN program given in the comment statements of subroutine 
DFAULT(). 

Since the amount of precision may change from computer to computer, the 
relative accuracy requested in the stopping criterion ZETA must not be less than 
about 500. times the machine relative precision SRIELPR. If a value of ZETA is 
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requested that is too small, then the code resets it to this value. The current 
default value for ZETA, 5.0E—6, is set by the routine DFAULT() into 
RPARM(1). 

The distribution tape contains the ITPACK 2C software package of 71 subpro- 
grams and a testing program MAIN() together with its 27 subprograms. The 
routines DFAULT(), ITICK(), ITOCK() in ITPACK and the program 
MAIN() are the only ones requiring editing by the installer of the package. 
ITPACK can be made into a compiled program library, although not all of it 
would normally be used in a particular application. 


8. ITPACK HISTORY 


The 2C version of the ITPACK codes described here is the result of several years 
of research and development. The development of ITPACK began in the early 
1970s when Professor Garrett Birkhoff suggested that general-purpose software 
for solving linear systems should be developed for iterative methods as well as for 
direct methods. Initially, prototype programs were written based on preliminary 
iterative algorithms involving adaptive selection of parameters and automatic 
stopping procedures. These programs were tested on a large set of elliptic partial 
differential equations over domains compatible with the subroutine REGION( ) 
[8], which superimposed a square grid over the domain. These routines were 
designed for solving self-adjoint elliptic partial differential equations. Next a 
preliminary version of ITPACK was coded in standard FORTRAN. The ITPACK 
routines used iterative algorithms that were refined from the prototype programs. 
However, these routines were designed to solve large sparse linear systems of 
algebraic equations instead of partial differential equations. The use of three 
interchangeable symmetric sparse storage modes in ITPACK 1.0 [3] allowed for 
great flexibility and made it possible to solve a wider class of problems than the 
prototype programs and to study different storage modes for iterative methods. 
The next version, ITPACK 2.0 [4], was significantly faster than its predecessor, 
since it was restricted to allow only one sparse symmetric storage format. Most 
of the iterative algorithms utilized in the 2.0 version of this package assume that 
the coefficient matrix of the linear system is symmetric positive definite. As with 
many packages, the need to handle a slightly larger class of problems, namely, 
nearly symmetric systems, soon became evident. This required adapting the 
routines to allow a switch for either a symmetric or nonsymmetric storage mode 
in ITPACK 2A [5]. Moreover, a modification of the conjugate gradient algorithms 
was developed to handle nearly symmetric systems [13]. ITPACK has been 
improved in the 2B version [11] by (a) writing more efficient versions of several 
key subroutines, (b) incorporating basic linear algebra subprograms (BLAS) 
[15], and (c) improving the user interface with better printing and documentation. 
Some additional improvements and corrections were made in the 2C version. The 
algorithms in ITPACK are not guaranteed to converge for all linear systems, but 
have been shown to work successfully for a large number of symmetric and 
nonsymmetric systems that arise from solving elliptic partial differential equa- 
tions [1, 14]. 

The numerical algorithms in ITPACK 2C correspond to those described in the 
appendix of technical report [4] and outlined in the book [6]. In particular, the 
SOR code is based on an algorithm suggested to us by L. Hageman. Various other 
algorithms exist for iterative methods. For example, S. Eisenstat has an imple- 
mentation of the symmetric successive overrelaxation preconditioned conjugate 
gradient procedure.’ 

Modules based on the seven iterative routines in ITPACK have been incorpo- 
rated into the elliptic partial differential equation solving package ELLPACK 
[17] together with all the necessary translation routines needed. The user-oriented 
modules described in Section 4 are not in ELLPACK. Moreover, if the ELLPACK 


? Private communication. 


COLLECTED ALGORITHMS (cont.) 586-P16- 0 


system is not being used to generate the linear system for ITPACK, it is 
recommended that ITPACK be used as a stancl-alone package apart from 
ELLPACK. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service .] 


SUBROUTINE JCG(NN, IA, JA,A,RHS,U, IWKSP,NW,WKSP, 


A 


IPARM, RPARM, IERR) 


ITPACK 2C MAIN SUBROUTINE JCG (JACOBI CONJUGATE GRADIENT) 
EACH OF THE MAIN SUBROUTINES: 

JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI 
CAN BE USED INDEPENDENTLY OF THE OTHERS 


FUNCTION: 


THIS SUBROUTINE, JCG, DRIVES THE JACOBI CONJUGATE 
GRADIENT ALGORITHM. 


«++ PARAMETER LIST: 


N 


IA, JA 


A 


IPARM 


RPARM 


IER 


INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN) 
INPUT INTEGER VECTORS. 
THE SPARSE MATRIX REPRESENTATION. 

INPUT REAL VECTOR. THE REAL ARRAY OF THE SPARSE 
MATRIX REPRESENTATION. 

INPUT REAL VECTOR. CONTAINS THE RIGHT HAND SIDE 
OF THE MATRIX PROBLEM. 


INPUT/OUTPUT REAL VECTOR. 
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ALGORITHM 587 
Two Algorithms for the Linearly Constrained 
Least Squares Problem 


RICHARD J. HANSON and KAREN H. HASKELL 
Sandia National Laboratories 


Categories and Subject Descriptors: G.1.2. [Numerical Analysis]: Approximation—least squares 
approximation; G.1.6. [Numerical Analysis]: Optimization—constrained optimization; least 
squares methods; G.m [Mathematics of Computing]: Miscellaneous—FORTRAN 


General Terms: Algorithms 


Additional Key Words and Phrases: linear least squares solution, equality constraints, inequality 
constraints, nonnegativity constraints, inconsistent constraints, covariance matrix 


1. INTRODUCTION 


This paper discusses subroutines for computing numerical solutions of the follow- 
ing two linearly constrained linear least squares problems. 


Problem NNLSE Ex=f (equations to be exactly satisfied) 
Ax=b_ (equations to be approximately (1) 
satisfied, least squares sense) 
x=0, t=l+1,...,n, Oslsn 


Problem LSEI Ex=f (equations to be exactly satisfied) 
Ax=b_ (equations to be approximately 
satisfied, least squares sense) (2) 


Gx=h_ (inequality constraints that the 
solution must satisfy) 


In both problems the matrices E and A are real and of respective dimensions 
mr by n and ma by n. For Problem NNLSE, the variables x1, ..., x; are free to 
have either sign. For Problem LSEI, the (real) inequality constraint matrix G is 
me by n. The right-side vectors f, b, and h that appear in the two problem 
statements have, respectively, mz, ma, and mg components. The (unknown) 
solution vector x has n components. 

While Problem LSEI of eq. (2) appears to be a more general problem than 
Problem NNLSE of eq. (1), it really is not. In fact, there are a number of ways to 
transform Problem LSEI into one of the forms of Problem NNLSE. Three ways 
of doing this are discussed in [3]. The method we have implemented is described 
on pages 101-102. The successful implementation of an algorithm for solving 
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Problem NNLSE is the key computational process. Nevertheless, it is important 
for applications such as constrained curve fitting [2] to have a subprogram that 
solves Problem LSEI of eq. (2) directly. We provide FORTRAN subprograms 
WNNLS( ) and LSEI( ) that solve the respective problems in eqs. (1) and (2). 

In Section 2 we review mathematical and numerical analysis details pertinent 
to solving Problem LSEI. In Section 3 we review some necessary details for 
understanding our methods for solving Problem NNLSE. In Section 4 we sum- 
marize some features and advantages of the codes. These features include 
changing tolerances, scaling of data matrices, and optional computation of the 
covariance matrix. Section 5 presents a test subprogram CLSTP( ), which is 
included with the package. It solves the test problem with both subprograms. 
Section 6 contains installation guidelines and remarks. 


2. SOLVING PROBLEM LSEI 


In this section, we briefly review mathematical and algorithmic cletails needed to 
solve Problem LSEI of eq. (2) [8, pp. 101-102]. The overall process consists of 
four main parts. 


Step 1 Problem LSEI is reduced to a subproblem with possibly fewer unknown 
variables and with all explicitly stated equality constraints removed. 

Step 2. The problem resulting from step 1 is reduced to a new problem where 
the least squares matrix is a simple projection matrix and the right-side 
vector is zero. 

Step 3 The problem resulting from step 2 is solved by reposing it as a dual 
problem. This dual problem consists of two special cases of Problem 
NNLSE, eq. (1). 

Step 4 The solution obtained in step 3 is transformed to the solution of the 
original problem using translations, matrix multiplications, and the 
solution of triangular linear algebraic systems. 


3. SOLVING PROBLEM NNLSE 


The theoretical development for solving problem NNLSE of eq. (1) is presented 
in [3]. The fundamental point of this method involves a numerically stable 
implementation of a penalty function approach. The least squares equations are 
each weighted by a small parameter «, chosen in the subprogram WNNLS( ). 
The augmented and weighted least squares system of eq. (3) is then solved. 
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Part of the theoretical development in [3] shows that solutions of the weighted 
problem of eq. (3) converge to solutions of Problem NNLSE (if it is consistent) 
as € — 0. Within the subprogram WNNLS( ) eq. (3) is solved only once with a 
value of « that is chosen to achieve full working HOUnACY. in the solution. The 
value used in WNNLSC( ) is defined by 


10-* 
e=—, (4) 
Y 
where y = ||4]|, (|| - |] = subordinate matrix norm of L., vector norm), and 7 = 


machine relative arithmetic precision. 
The algorithm for solving eq. (3) with € as defined in eq. (4) proceeds in two 
main steps. First we compute a (minimum-length) solution for the unconstrained 
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variables in terms of the constrained variables. Solving for the unconstrained 
variables is primarily a triangularization operation. In the second main step of 
the process we solve for the constrained variables. This is an iterative process, 
that is, it is Algorithm NNLS of [7, Chap. 23]. Certain crucial differences in 
numerical tests are needed because of the penalty parameter e€ that multiplies the 
least squares equations. These tests are discussed in [8]. 


4. USAGE SUGGESTIONS AND SUBPROGRAM OPTIONS 


In Sections 2 and 3 we have outlined solution methods for solving Problem LSEI 
of eq. (2) and Problem NNLSE of eq. (1). As shown in [3], computing the solution 
of Problem NNLSE can be regarded as the core computation in solving con- 
strained linear least squares problems. 

The most satisfactory method from the standpoint of accuracy and stability is 
to introduce slack variables into the inequality constraints of Problem LSEI [3]. 
This problem is then solved using subprogram WNNLSC ). The results of solving 
a bounded variable Hilbert matrix problem summarized in [38] suggest that 
subprogram WNNLS( ) continues to compute acceptable solutions even as the 
problems become increasingly ill-conditioned. 

The use of subprogram WNNLS( ) with the slack variable formulation does 
have a disadvantage compared to subprogram LSEI( ). For most problems, 
WNNLS( ) will require more computing time and storage than LSEI( ). This is 
due to the larger number of problem variables in the slack variable formulation. 
The advantage of efficiency with LSEI(_ ) may be countered by the simultaneous 
occurrence of poor conditioning and rounding errors. (This can occur with a 
poorly conditioned least squares problem.) Owing to the poor conditioning and 
rounding error, the feasible constraint region can be mapped to one that is 
infeasible. Instances of this are shown in the results of solving the bounded 
variable Hilbert matrix problem summarized in [3]. 

The choice between the two subprograms is a time and storage versus stability 
trade-off. Specifically, in the case of a poorly conditioned least squares problem, 
WNNLS( ) might obtain a solution when LSEI( ) cannot. As illustrated in [3], 
subprogram WNNLS( ) can also be used to extend the notion of solution for 
problems with infeasible constraints. 

Occasionally, a user of subprogram LSEI( ) will need the covariance matrix of 
the least squares solution variables of minimum length. This is returned as an 
output matrix if the user wants it. It is an unbiased estimate of the covariance 
matrix for the minimum-length solution of an equality constrained least squares 
problem with no inequalities. This is developed in [4] and [6]. 

When inequalities are included, certain additional mathematical problems must 
be considered. These have to do with the behavior of the set of inequalities 
chosen by the algorithm to be equalities. The question is as follows: What is the 
sensitivity of these equalities as the data are allowed to vary within its uncer- 
tainty? Inequalities may move from being satisfied as equalities to strict inequal- 
ities as the data are perturbed. The covariance matrix computed by LSEI( ) is 
based on the assumption that the set of equalities does not change when the 
solution is perturbed. No comprehensive theory is known to the authors for 
determining the matrix when the set of equalities does change. The user must 
keep these facts in mind when interpreting the covariance matrix for Problem 
LSEI with inequalities. 

The remainder of this section describes parameters within LSEI( ) and 
WNNLS( ) which can optionally be changed by the user. These options fall into 
the three following groups. 


(A) Computation of the covariance matrix. 
(B) Column scaling of the data matrix. 
(C) Redefinition of tolerances used for determining ranks of problem matrices. 
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Changes to any number of these parameters can be specified as the linked-list 
input in the array PRGOPT(*). Precise instructions for defining PRGOPT(*) 
are found in the usage prologues for LSEI( ) and WNNLSC( ). If the user is 
satisfied with the nominal subprogram features, it is only necessary to set 
PRGOPT(1)=1. | 


Remarks about A: Nominally the covariance matrix is not computed by 
LSEI( ). 

Remarks about B: Column scaling of the form x = Dy is always performed by 
LSEI( ) and WNNLS( ). Nominally D is the identity matrix. Another option 
here is a choice for D such that each nonzero column of the entire scaled data 
matrix has length one. The user can also specify an‘ arbitrary D. 

Remarks about C: The user can change tolerances tg, and ta in LSEI( ) and 
tolerance tw in WNNLS( ). The nominal values of tz, ta, and tw are 7'/”, where 
7 is the relative arithmetic precision of the machine. The parameter ¢y is used in 
approximating the rank of the equality constraint matrix EF of eq. (2). Its role is 
discussed near the end of [3, Sec. 1]. 


The parameter ¢, is used in approximating the rank of the least squares matrix 
that results from eliminating the equality constraints from eq. (2). It is used to 
compute the factor r, which is ¢4 times the norm of this reduced least squares 
matrix. Then 7 is used in Algorithm HFTT [7, Chap. 14]. 

The parameter tw is used by WNNLS(_) to compute the rank of the row-scaled 
least squares matrix as discussed in [3, Sec. 3.1]. 


5. REMARKS ON THE TESTING SUBPROGRAM CLSTP( ) 


The subprogram CLSTP (KLOG, COND, ISTAT) constructs and solves a 
constrained least squares problem that has a known solution and known condition 
numbers [7, Chap. 9]. The problem generated is stated in eq. (2). The matrices A, 
E, and G are computed using formulas 


A=U,S\Vi 

E = U282.V2 
and 

G = U383V3. 


The problem dimensions are specified by using five integer parameters ka, ke, 
ko, kr, and kn to compute ma = 2", mg = 2**, mg = 2”, and n = 2", The integer 
m,; = 2” denotes the number of inequality constraints that are to be satisfied as 
strict inequalities. These five integers are passed to CLSTP( ) in the array 
KLOG(*) in the order indicated. If any of the values ka, kr, ka, kr, or kn are less 
than zero, the respective values ma, mz, Mc, m1, or m, are set to zero. No 
computation is performed if n = 0. 

Arrays within CLSTP( ) currently have fixed dimensions that require ka, ke, 
ka, k1, and k, to all be less than or equal to 5. Instructions for increasing the 
array dimensions are given as comments within CLSTP( ). 

The matrices U,; and V, are symmetric orthogonal Hadamard matrices of 
dimension n = 2* generated by the recursion 


n:=1 
U :=1 
For J/=1,...,R% 
U U 
v=ly Soo 
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The matrices S,;, J = 1, 2, 3, are rectangular diagonal matrices. The extreme 
diagonal terms are «; and 1, where x, = COND(J). The intermediate diagonal 
terms are generated in the open interval (1, «,) using the random number 
generator RAN( ). The output value of ¢ = RAN(UISEED) satisfies 0 < ¢ < 1. 
The intermediate diagonal terms are successively computed as 1 + ¢(k, — 1).. 
Initially, ISEED is set to 100001 in CLSTP( ). 


The n-vector X = (1,..., 1)" is used to generate the vectors 

f= Ex 

b = Ax 
and 

h = Gk. 
We add a vector b to b that is orthogonal to the column space of A. This is 
given by 

b= Ui, ..., 0, nti, .- +, Bm,)s 

where 


gi = RAN(SEED).||b|-o, i=n+1,..., ma. 


The value of o is specified by the variable ANSR in CLSTP( ). It is currently set 
to 0.01. The right-side vector for the least squares equations in eq. (2) is b = b 
+b. 

The right-side vector for the inequality constraints is constructed by making 
the first my constraints strict inequalities. This is done by defining the right-side 
vector as h = h — h, where 


b= (i, 4.55 Mal Opi 30), 
hi=RAN(SEED).||h||, 9 ¢=1,..., mv. 


These techniques for generating problems with known solutions are similar to 
those discussed in [9, pp. 6-9]. One might obtain different sets of test problems 
on machines with differing arithmetic characteristics. Part of this is due to a 
different sequence of numbers generated by RANC ). 

We have found that column scaling is sometimes required for solving eqs. (1) 
and (2). In particular, when using 32-bit floating-point arithmetic, problems 
generated by CLSTP( ) using the published test data occasionally failed to pass 
the tests when no column scaling was done. Thus the option array input for calls 
to both LSEI( ) and WNNLSC ) are set so that unit length column scaling is 
performed on all the tests. 

After subprogram LSEI( ) has computed an approximate solution x’ for this 
particular form of eq. (2), and subprogram WNNLS( ) has solved for an approx- 
imate solution x” of the system 


Ex=f 
Ax=b 
Gx —-h=w 


for the unknown (x", w')", we compute the differences dx, = x’ — X and dx, = 
x” — X. A test is made on the value of || dx, || to ensure that x’ or x” is as accurate 
as it deserves to be. ‘The test of the subprogram has failed if the corresponding 
|| dx; || is too large. Otherwise the test: has passed and x’ or x” is an acceptable 


approximation of x. With 
p = || bi b| 


K = kK; = condition number of A 
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n = relative arithmetic precision 
pe = max(ma, n) 
vy = min(ma, n) 
® = 100 
each test has passed if and only if 


ey <= «(1 + Kp)y[(6u — 3%) rv]. 


The output value of ISTAT is set as follows: 


ISTAT = 1 means both LSEI( ) and WNNLS( ) failed. 
= 2 means WNNLS( ) passed but LSEIC(_ ) failed. 
= 3 means LSEI( ) passed but WNNLS( ) failed. 
= 4 means both LSEI( ) and WNNLSC( ) passed. 


This measure for || dx; || is based on combining the estimate for the norm of the 
matrix H of the nearby problem that x’ solves (without constraints), (A + H)x’ 
= b, [7, Chap. 13], together with the perturbation bounds of [7, Chap. 9]. 

It may be necessary to increase the value of ¢ slightly on some machines. 

A short main program, CLSTST, is provided with the algorithm. Also provided 
are 11 data cards that are read by CLSTST from FORTRAN unit = 5. Each pair 
of the first 10 cards specifies a distinct test case. The last (eleventh) card 
terminates the program execution. 

The subprogram CLSTP( ) prints the computed values of the least squares 
residual vector length and the vectors dx; for both WNNLS( ) and LSEIC( ). 
Also printed in CLSTP( ) are the computed ranks of the equality constraint and 
reduced least squares matrices returned by LSEI( ). The arrays KLOG(), I = 
1 to 5, and COND(D, J = 1 to 3, and the value of ISTAT returned from 
CLSTP( ) are printed by CLSTST. Printing is done on FORTRAN unit = 6. 


6. INSTALLATION GUIDELINES AND REMARKS 


This section contains information for installing subprograms LSEI( ) and 
WNNLS( ). 
Included in the package are seven groups of subprograms. 


(1) LSEI, LSI, LPDP 

(2) WNNLS, WNLSM, WNLIT 

(3) HFTI, H12, DIFF from [7] 

(4) SDOT, SSCAL, SASUM, SAXPY, SNRM2, SCOPY, SSWAP, ISAMAX, 
SROTM, SROTMG from [8]. (For double-precision usage DDOT, DSCAL, 
DASUM, DAXPY, DNRM2, DCOPY, DSWAP, IDAMAX, DROTM, 
DROTMG.) 

(5) XERROR, XERRWV, XERABT, XERCLR, XERCTL, XERDMP, XER- 
MAX, XERPRT, XERSAV, XGETF, XGETUA, XGETUN, XSETF, XSE- 
TUA, XSETUN, FDUMP, J4SAVE, S88FMT, NUMXER from [5]. (The 
subprogram NUMXER is included for completeness but is not used in this 
package.) 

(6) ILMACH based on [1] 

(7) CLSTST, CLSTP, RAN (test package) 


All of the subprograms are written in 1966 American National Standard 
portable FORTRAN. The only machine-sensitive subprogram is IIMACHC ). It 
provides two environmental parameters required by the error-handling subpro- 
grams XERROR( ) and XERRWV( ). This will require modification of 
ILMACHC ) at each host site. FORTRAN DATA statements defining the values 
of all the required constants are available for many machines in comments within 
the subprogram. The appropriate set of commented statements must be activated. 
If the values for your machine are not there, they should be provided in the order 
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corresponding to the description near the beginning of IMMACH( ). Machines 
for which these constants are provided are Honeywell 600/6000, IBM 360/370, 
Xerox Sigma, CDC 6000/7000, PDP-10 (KA and KI processors), PDP-11 (16- and 
32-bit arithmetic), Burroughs 5700/6700/7700, UNIVAC 1100, Data General 
Kclipse, Harris, VAX, and CRAY. In addition, the user must open or declare the 
FORTRAN unit, designated in IIMACH{(4), where any error messages will be 
written. 

We strongly recommend that calls to the error-handling subprograms XER- 
ROR( ) and XERRWVC{ ) be left intact. If the size or complexity of the error- 
handling package presents a problem on a particular machine, we suggest that 
the subprograms XERROR( ) and XERRWVC( ) be replaced by shorter, ma- 
chine-sensitive versions. These replacements should, minimally, print the char- 
acter string comprising the error message and the specified data values. Usage of 
the full error-handling package is discussed in [5]. 

To convert the package for double-precision usage, follow the editing instruc- 
tions at the beginning of each subprogram in groups 1, 2, 3, and 7 above. Use the 
double-precision version of the BLAS in group 4. No conversion is required for 
subprograms in groups 5 and 6. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service .] 


587-P 7- 


SUBROUTINE LSEI(W, MDW, ME, MA, MG, N, PRGOPT, X, RNORME, RNORML, LSEI 1¢@ 


* MODE, WS, IP) LSEI 2@ 
LSEL 3¢@ 
DIMENSION W(MDW,N+1) , PRGOPT(*), X(N), LSEL 4@ 
WS (2* (ME+N) +K+(MG+2) *(N+7)), IP (MG+2*N+2) LSEI 5¢@ 
ABOVE, K=MAX(MA-+MG,N). LSEI 6@ 
LSEIL 7@ 
ABSTRACT LSEI 8@ 
LSEL 9¢ 
THIS SUBPROGRAM SOLVES A LINEARLY CONSTRAINED LEAST SQUARES LSEI 10¢ 


PROBLEM WITH BOTH EQUALITY AND INEQUALITY CONSTRAINTS, AND, IF THELSEI 11¢ 


0 
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Qa 


aa 


USER REQUESTS, OBTAINS A COVARIANCE MATRIX OF THE SOLUTION 
PARAMETERS. 


SUPPOSE THERE ARE GIVEN MATRICES E, A AND G OF RESPECTIVE 


LSEI 
LSEI 
LSEI 
LSEI 


DIMENSIONS ME BY N, MA BY N AND MG BY N, AND VECTORS F, B AND H OFLSETL 


RESPECTIVE LENGTHS ME, MA AND MG. THIS SUBROUTINE SOLVES THE 
LINEARLY CONSTRAINED LEAST SQUARES PROBLEM 


EX = F, (E ME BY N) (EQUATIONS TO BE EXACTLY 
SATISFIED) 

B, (A MA BY N) (EQUATIONS TO BE 
APPROXIMATELY SATISFIED, 
LEAST SQUARES SENSE) 

GX.GE.H,(G MG BY N) (INEQUALITY CONSTRAINTS) 


AX 


THE INEQUALITIES GX.GE.H MEAN THAT EVERY COMPONENT OF THE PRODUCT 


GX MUST BE .GE. THE CORRESPONDING COMPONENT OF H. 
IN CASE THE EQUALITY CONSTRAINTS CANNOT BE SATISFIED, A 


GENERALIZED INVERSE SOLUTION RESIDUAL VECTOR LENGTH IS OBTAINED 
FOR F-EX. THIS IS THE MINIMAL LENGTH POSSIBLE FOR F-EX. 


ANY VALUES ME.GE.@, MA.GE.@, OR MG.GE.@ ARE PERMITTED. THE 


RANK OF THE MATRIX E IS ESTIMATED DURING THE COMPUTATION. WE CALL 


THIS VALUE KRANKE. IT IS AN OUTPUT PARAMETER IN IP(1) DEFINED 
BELOW. USING A GENERALIZED INVERSE SOLUTION OF EX=F, A REDUCED 
LEAST SQUARES PROBLEM WITH INEQUALITY CONSTRAINTS IS OBTAINED. 
THE TOLERANCES USED IN THESE TESTS FOR DETERMINING THE RANK 

OF E AND THE RANK OF THE REDUCED LEAST SQUARES PROBLEM ARE 
GIVEN IN SANDIA TECH. REPT. SAND 78-1299. THEY CAN BE 

MODIFIED BY THE USER IF NEW VALUES ARE PROVIDED IN 

THE OPTION LIST OF THE ARRAY PRGOPT(*). 


THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO 


DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. 


USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. 

(START EDITING AT LINE WITH C++ IN COLS. 1-3.) 

/REAL (12 BLANKS)/DOUBLE PRECISION/,/SASUM/DASUM/,/SDOT/DDOT/, 
/SNRM2/DNRM2/,/ SQRT/ DSQRT/,/ ABS/ DABS/,/AMAX1/DMAX1/, 
/SCOPY/DCOPY/ ,/SSCAL/DSCAL/ , /SAXPY/DAXPY/, /SSWAP/DSWAP/, /E@/D@/, 
/, DUMMY/ ,SNGL(DUMMY)/, /SRELPR/DRELPR/ 


WRITTEN BY R. J. HANSON AND K. H. HASKELL. FOR FURTHER MATH. 
AND ALGORITHMIC DETAILS SEE SANDIA LABORATORIES TECH. REPTS. 
SAND 77-0552, (1978), SAND 78-1290, (1979), AND 

MATH. PROGRAMMING, VOL. 21, (1981), P.98-118. 


SUBROUTINE WNNLS(W, MDW, ME, MA, N, L, PRGOPT, X, RNORM, MODE, 
* IWORK, WORK) 


DIMENSION W(MDW,N+1)., PRGOPT(*) , X(N), [WORK (M+N) , WORK (M+54N)) 
ABSTRACT 


THIS SUBPROGRAM SOLVES A LINEARLY CONSTRAINELT LEAST SQUARES 
PROBLEM. SUPPOSE THERE ARE GIVEN MATRICES E AND A OF 
RESPECTIVE DIMENSIONS ME BY N AND MA BY N, AND VECTORS F 
AND B OF RESPECTIVE LENGTHS ME AND MA. THIS SUBROUTINE 
SOLVES THE PROBLEM 


EX = F, (EQUATIONS TO BE EXACTLY SATISFIED) 


AX 


B, (EQUATIONS TO BE APPROXIMATELY SATISFIED, 
IN THE LEAST SQUARES SENSE) 


SUBJECT TO COMPONENTS L+l,...,N NONNEGATIVE 
ANY VALUES ME.GE.0, MA.GE.@ AND @.LE. L .LE.N ARE PERMITTED. 


THE PROBLEM IS REPOSED AS PROBLEM WNNLS 


LSEI 
LSEI 
LSEL 
LSEL 
LSE 
LSEL 
LSEL 
LSEI 
LSEI 
LSEL 
LSEI 
LSEI 
LSEL 
LSEI 
LSEL 
LSEL 
LSEI 
LSEI 
LSEI 
LSEL 
LSE 
LSEI 
LSEI 
LSEL 
LSEL 
LSE 
LSEL 
LSEI 
LSEI 
LSEL 
LSEL 
LSEL 
LSEI 
LSE 
LSEL 
LSEL 
LSEI 
LSEL 
LSEI 
LSEI 
LSE 
LSEL 


12¢ 
130 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
270 
28 
29¢ 
300 
310 
326 
330 
346 
35¢ 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 
47 
480 
496 
500 
5106 
520 
530 
540 
55¢@ 
560 
570 
58 


10 
20 
30 
4@ 
50 
60 
70 
80 
90 
100 
110 
120 
130 
140 
150 
160 
170 
18¢ 
190 
200 
210 
220 
230 
240 
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(WI*E)X = (WT*F) 


( 


A) (  B), (LEAST SQUARES) 


SUBJECT TO COMPONENTS Lt+l,...,N NONNEGATIVE. 


THE SUBPROGRAM CHOOSES THE HEAVY WEIGHT (OR PENALTY PARAMETER) WT. 


THE PARAMETERS FOR WNNLS ARE 


INPUT.. 


W(*,*) , MDW, 
ME,MA,N,L 


PRGOPT(*) 


THE ARRAY W(*,*) IS DOUBLE SUBSCRIPTED WITH FIRST 
DIMENSIONING PARAMETER EQUAL TO MDW. FOR THIS 
DISCUSSION LET US CALL M = ME + MA. THEN MDW 
MUST SATISFY MDW.GE.M. THE CONDITION MDW.LT.M 

IS AN ERROR. 


THE ARRAY W(*,*) CONTAINS THE MATRICES AND VECTORS 


CE: -F) 
(AB) 


IN ROWS AND COLUMNS 1,...,M AND 1,...,N+1 
RESPECTIVELY. COLUMNS 1,...,L CORRESPOND TO 
UNCONSTRAINED VARIABLES X(1),...,X(L). THE 
REMAINING VARIABLES ARE CONSTRAINED TO BE 
NONNEGATIVE. THE CONDITION L.LT.@ .OR. L.GT.N IS 
AN ERROR. 


THIS ARRAY IS THE OPTION VECTOR. 
IF THE USER IS SATISFIED WITH THE NOMINAL 
SUBPROGRAM FEATURES SET 


PRGOPT(1)=1 (OR PRGOPT(1)=1.90) 


250 
260 
27 
280 
296 
300 
310 
320 
330 
340 
350 
360 
37 
380 
390 
400 
410 
420 
430 


440 
450 
460 
470 
480 
490 
500 
516 
520 
530 
540 
550 
560 
57@ 
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ALGORITHM 588 
Fast Hankel Transforms Using Related 
and Lagged Convolutions 


WALTER L. ANDERSON 
U.S. Geological Survey 


Categories and Subject Descriptors: F.2.1 [Analysis of Algorithms and Problem Complexity]: 
Numerical Algorithms and Problems—computation of transforms; G.1.2 [Numerical Analysis]: 
Approximation—linear approximation; G.m [Mathematics of Computing]: Miscellaneous—FOR- 
TRAN 


General Terms: Algorithms 


Additional Key Words and Phrases: Hankel transforms of integer order, Bessel functions of the first 
kind, convolution integrals, linear digital filters 


DESCRIPTION 


Subprogram HANKEL( ), for evaluating complex Hankel transforms, is a com- 
plement of [1], where the algorithm is discussed in more detail. A double-precision 
real version, subprogram DHANKL ), is also provided. The calling sequence for 
DHANKL() is ordered the same way as is described below for HANKEL(), 
except all REAL and COMPLEX declarations in HANKEL() are declared 
DOUBLE PRECISION in DHANKL( ). 


REFERENCES 
1. ANDERSON, W.L. Fast Hankel transforms using related and lagged convolutions. ACM Trans. 
Math. Softw. 8, 4 (Dec. 1982), 344-368. 


ALGORITHM 


[Summary information and a part of the listing is printed here. The entire 
package, including subprogram HANKEL() and three drivers, followed by 
DHANKL( ) and one driver, is available from the ACM Algorithms Distribution 
Service. ] 


Module Names 


SUBROUTINE HANKEL( ) 
[MAIN PROGRAM—HANKEEL TEST 1] 
COMPLEX FUNCTION FUNT1() 
FUNCTION EXPM() 

[MAIN PROGRAM—HANKEL TEST 2] 
COMPLEX FUNCTION FUNT2() 
FUNCTION SINHM() 

[MAIN PROGRAM—HANKEL TEST 3] 
COMPLEX FUNCTION FUNT3() 


SUBROUTINE DHANKL( ) 
[MAIN PROGRAM—DHANKL TEST 1D] 


Received 7 March 1980; revised 5 May 1982; accepted 29 July 1982 
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DOUBLE PRECISION FUNCTION DFUNT1() 
DOUBLE PRECISION FUNCTION DEXPM() 


SUBROUTINE HANKEL (BMAX, NB, NREL, TOL, NTOL, NORD, FUN1, IJREL, ZWORK, 
* ZANS, ARG, NOFUN1, IERR) 


INTEGER NB, NREL,NTOL, NORD(NREL) , IJREL(2,NREL) , NOFUN1, TERR 
REAL BMAX, TOL, ARG(NB) 
COMPLEX ZWORK(283,NREL) , ZANS (NB, NREL) 


It 
i 
il 
ul 
tl 
I 
tt 
Nt 
HT] 
ll 
i] 
i] 
i] 
tt 
il 
WW 
il 
I 
Il 
tl 
Hl 
Il 
tl 
I 
Il 
Il 
if 
N 
it 
I 
tt 
N 
ll 
UI 
Il 
i] 
it 
tl 
i] 
ul 
H 
I 
Ht 
il 
tl 
it 
H 
il 
ii 
Hl 
i 
Il 
Il 
i] 
i 
i] 
il 
ll 
i] 
Il 
ii 
il 
It 
i] 
i] 
i 
" 
I 


PURPOSE 


5 


HAN 


THE PURPOSE OF SUBPROGRAM HANKEL IS TO PROVIDE IN SINGLE PRECISIONHAN 


A GENERAL ALGORITHM FOR FAST COMPLEX HANKEL TRANSFORMS OF ORDERS 
@ AND 1 USING RELATED AND LAGGED CONVOLUTIONS. 


AUTHOR 

ANDERSON, W.L., U.S. GEOLOGICAL SURVEY, DENVER, COLORADO. 

REFERENCES 

1. ANDERSON, W.L., IMPROVED DIGITAL FILTERS FOR EVALUATING 
FOURIER AND HANKEL TRANSFORM INTEGRALS. N.T.1I.S REPT. 
PB-242-86@, SPRINGFIELD, VA., 1975. 

2. ANDERSON, W.L., NUMERICAL INTEGRATION OF RELATED HANKEL 
TRANSFORMS OF ORDERS @ AND 1 BY ADAPTIVE DIGITAL FILTERING. 
GEOPHYSICS 44 (JULY 1979), 1287-1365. 

LANGUAGE 


ANS-FORTRAN (X3.9-1966) IS USED, WITH THE EXCEPTION OF THE 
CHARACTERS F,!,&,:,1,J APPEARING IN SOME COMMENT STATEMENTS. 


HAN 
HAN 
HAN 
HAN 
HAN 
HAN 
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ALGORITHM 589 

SICEDR: A FORTRAN Subroutine 

for Improving the Accuracy of Computed 
Matrix Eigenvalues 


JACK J. DONGARRA 
Argonne National Laboratory 


Categories and Subject Descriptors: G.1.3 [Numerical Analysis]: Numerical Linear Algebra— 
eigenvalues; G.m [Mathematics of Computing]: Miscellaneous—FORTRAN 

General Terms: Algorithms 

Additional Key Words and Phrases: Matrix eigensystems, iterative method; eigensystem 
improvement 


1. INTRODUCTION 


SICEDR is a FORTRAN subroutine for improving the accuracy of a computed 
real eigenvalue and improving or computing the associated eigenvector. It is first 
used to generate information during the determination of the eigenvalues by the 
Schur decomposition technique. In particular, the Schur decomposition technique 
results in an orthogonal matrix @ and an upper quasi-triangular matrix 7, such 
that 


A= QTQ'. (1.1) 


Matrices A, Q, and T and the approximate eigenvalue, say A, are then used in the 
improvement phase. SICEDR uses an iterative method similar to iterative 
improvement for linear systems to improve the accuracy of A and improve or 
compute the eigenvector x in O(n”) work, where n is the order of the matrix A. 
The method used in SICEDR is described in [1, 5]. 


2. USAGE 


For a description of the calling sequence, see the listing presented at the end of 
this paper. 


SICEDR factors the matrix into its Schur decomposition, and this is termed 
the pre-SICE phase. A modification of the EISPACK routine HQR2 is used for 
this purpose (see [4, pp. 100-101] for details). 

During the improvement phase (or SICE phase), SICEDR is called with 
matrices A, T, and Q and the approximate eigenvalue W. On return from 
SICEDR the improved eigenvalue is stored in W and the improved or computed 
eigenvector in X. W and X contain the corrected eigenpair produced by the 
method at the next to last iteration. A still more accurate eigenpair can be formed 
if on return from SICEDR the user adds W to CW and X to CX in double 
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precision and saves the results in double precision, where CW and CX contain 
the corrections to W and_X, respectively, at the final iteration when the method 
terminates. 

The routine SICEDR is provided as a driver to simplify usage. SICEDR 
performs both the pre-SICE phase (reduction to upper form) and the SICE phase 
(improvement). 

In addition to the EISPACK package, the LINPACK [2] routine STRSL and 
the BLAS [8] package are used to perform fundamental operations. 

To produce a double-precision version of SICEDR in addition to making the 
obvious changes, such as changing variables to double precision and using double- 
precision intrinsic functions, it is necessary to replace routine STRSL by DTRSL 
and use the double-precision version of the BLAS. In addition, there are two 
critical parts of the calculation which must be performed in an extended precision. 
In the single-precision version, the routine SDDDOT and SDADD perform 
double-precision accumulations. In a double-precision version, they must be 
replaced by, say DQQDOT and DQADD, the extended precision counterparts. 
These extended precision routines would accumulate in quadruple precision, a 
nonstandard FORTRAN construct. Such routines are not included here, but can 
be constructed from the BLAS routines DQDOTI and DQDOTA. 


3. SUMMARY OF THE ALGORITHM 


We begin with a brief discussion of the basic algorithm as described in [1]. 
If A, x is an approximate eigenpair, and A + p, x + 3’ is a neighboring eigenpair, 
then 


A(xt+ y) = (A+ p(x +9), (3.1) 


this relation being exact. We assume that x is normalized so that || x ||. = 1= Xs, 
and we remove the degree of arbitrariness in Y by requiring that y, = 0. 
Rearranging this equation, we have 


(A —ALl)¥ — px =Ax — Ax + py, (3.2) 


where the last term on the right will be of second order in the errors of A, x. The 
equation above may be simplified by the introduction of a vector y defined by 


ye (y1, 2, +425 Vs-1, BP, Vetry vary Yas (3.3) 
so that y gives the full information on both p and y. The above equation then 
becomes 

By =r+ ysJ, (3.4) 


where r = Ax — Ax is the residual vector corresponding to A, x and B is the 
matrix A — AJ with column s replaced by —x. 

When the original approximate eigenpairs have been found by Francis’ double 
QR algorithm, we have an orthogonal matrix Q and a quasi upper triangular 
matrix 7, such that 


A = QTQ". (3.5) 


T is triangular apart from possible 2 x 2 diagonal blocks corresponding to complex 
conjugate eigenvalues. We solved a succession of linear systems of the form (3.4) 
with varying right-hand sides g. It will be convenient to introduce the generic 
notation Z — AI = Z, and (Z — Al)es = Zyes = 2s. We may then rewrite eq. (3.4) 
in the form | 

[Ay — (x + as)es ly = (Ay + ces ly = 8, (3.6) 
where 


C= —-X — A)s. 


COLLECTED ALGORITHMS (cont.) 589-P 3- 0 
Using the orthogonal factorization, we have 
Q[Tr + Q*ceQ1Qy = g, 
giving 
(Ty + df)Q"y = Q"8, (3.7) 
where 
d=Q"ce, f'=elQ and g=rt+y.¥. 


The matrix df” is a rank one modification of the quasi-triangular matrix 7,. To 
solve this system, we need to retriangularize T, + df". Accordingly, we premul- 
tiply the system by two orthogonal matrices Q; and Qe, giving 


Q2Q1(Tr + df ™)Q*y = Q2.91978, (3.8) 
where @; and Q»2 are products of elementary plane rotations determined as 
follows. 

The matrix Q, is such that 
Qid= (P2P3 cee P,)d= yé1 where = || d |l2 (3.9) 


and P; is a rotation in the (i — 1, i) plane designed to annihilate the ith component 
of Pis1 Piste +++ Prd. We have 


Q(T, + df") = QT, + yeif",; (3.10) 


where @1T) is upper Hessenberg, while ye: f" is null except in the first row. Hence 
the right-hand side is also an upper Hessenberg matrix H. H may now be reduced 
to upper triangular form, T,, by premultiplication with Q2 defined by 


Os SP) ss PPS, (3.11) 


where the premultiplication by P; annihilates the element (7, i — 1) of the current 
matrix by a rotation in the (z — 1, z) plane. Hence, the triangular system remains 
to be solved 


Tr.Q*y = Q291Q"8. (3.12) 


A system with the matrix B may thus be solved in O(n”) operations. 

By its nature, eq. (3.2), which leads to eq. (3.12), is mildly nonlinear. Thus we 
repeat the process with x + ¥ and A + pw as the new approximations. The 
convergence theorem for this iterative procedure can be found in [1]. Since an 
orthogonal triangularization of A is available, it becomes practical to update the 
matrix B at each stage of the iteration, using the current approximation to the 
eigenpair. Accordingly, we treat the (p + 1)th step of the iteration as though it 
were the first step in the basic iteration starting with values A”) and x‘”’. Since 
we treat each iterate as if it were the first, the term py in eq. (3.2) is zero. Thus 
g =Ax — Ax. The algorithm then becomes 


(A = AMT) ¥) _ Px) _ re = (AT — A)x (3.13) 

where 
x (PTD _ xP) + vy ?), PTD = A) + yy?) 
We may rewrite this as 
BP y'P) = r'?), (3.14) 

where 

BM =A —-AMT+ cPel ce?) = =x — al?), 
We now write 


B® = Q(T?) + QTc eT Q)Q™ 
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= QTY? + dF") Q* (3.15) 
and solve (3.14) by the triangular system 
TPQTy”?) = OY? Of? Qtr, (3.16) 


Convergence is detected by examining successive values for the correction to the 
eigenvalue. When the previous correction is smaller by a factor of 2 than the 
current correction, the iteration is stopped. 

Note that Q and f will be independent of p if s is not changing from one 
iteration to the next. The rotations involved in Q{”’ and Q4”’, on the other hand, 
differ from one iteration to the next; but because the number of operations in 
each retriangularization is O(n”) and since some 4n? rnultiplication and additions 
are necessarily involved in the solution of a triangular system, this is quite 
acceptable. 

If we examine the number of operations for the reduction to quasi-triangular 
form, the pre-SICE phase, we see that there are roughly 10n* + 30n” operations 
involved (here, an operation means a multiplication followed by an addition). For 
the SICE phase there are approximately 13n” operations per iteration. Assuming 
3 iterations to improve an eigenpair, the total count is approximately 39n” 
operations. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Algorithms Distribution Service. | 


SUBROUTINE SICEDR(LD, N, A, T, Q, W, X, CW, CX, K, Yl, Y2, R, Z1, SIC 


* WR, WI, JOB, INFO, INIT) SIC 
SIC 

INTEGER I, J, IP1, IERR, LD, N, K, JOB, INFO, INIT SIC 
REAL A(LD,1), T(LD,1), Q(LD,1), WR(1), WI(1) SIC 
REAL W, X(1), CW, CX(1), Y1(1), Y2(1), R(1), Z1(1) SIC 
SIC 

THIS SUBROUTINE PROVIDES TWO FUNCTIONS DEPENDING ON SIC 
THE VALUE OF INIT. SIC 
SIC 

1) TO REDUCE A MATRIX TO QUASI-TRIANGULAR. FORM, SIC 
ACCUMULATING THE ORTHOGONAL TRANSFORMATIONS, SIC 

AND DETERMINE THE EIGENVALUES OF THE MATRIX. SIC 

SIC 

2) TO IMPROVE THE ACCURACY OF AN EIGENVALUE AND SIC 
IMPROVE THE EIGENVECTOR OR COMPUTE ANI’ IMPROVE THE SIC 
EIGENVECTOR, GIVEN THE ORIGINAL MATRIX, AN SIC 
APPROXIMATE EIGENVALUE, THE QUASI-TRIANGULAR MATRIX, SIC 

AND THE ORTHOGONAL MATRIX WHICH PRODUCED THE SIC 
QUASI-TRIANGULAR FORM. sic 

SIC 

THESE FUNCTIONS ARE SIGNALED BY THE PARAMETER INIT. SIC 
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ALGORITHM 590 

DSUBSP and EXCHQZ: FORTRAN 
Subroutines for Computing Deflating 
Subspaces with Specified Spectrum 


P. VAN DOOREN 
Stanford University 


Categories and Subject Descriptors: G.1.38 [Numerical Analysis]: Numerical Linear Algebra— 
eigenvalues; G.m {Mathematics of Computing]: Miscellaneous—FORTRAN 


General Terms: Algorithms 


Additional Key Words and Phrases: Generalized eigenvalue, QZ algorithm 


1. DESCRIPTION 

A reliable and widely available method to compute the generalized eigenvalues of 
an n X n real regular (i.e., invertible) pencil AB — A is the so-called QZ-algorithm 
[1, 3]. This algorithm constructs orthogonal row and column transformations @1 
and Z; such that the transformed pencil 


ABi — Ai = Qi(AB — A)Z1 (1) 


is in “quasi-triangular” form, that is, with B, in upper triangular form and A; in 
block triangular Hessenberg form with 1 x 1 and 2 xX 2 diagonal blocks, as 
illustrated below: 


Xx X X X X X Xx xX X X X XI 
Me A Re “ie x xX X xX XxX) 
B= x xX KK] fe xX xX X X X (2) 
xX xX X xX xX X 
xX xX xX xX 
X | xX xX 


The 1 X 1 diagonal pencils of 1B; — A; contain the real generalized eigenvalues 
of the pencil AB — A, and the 2 X 2 diagonal pencils of AB; — Ai contain the 
complex generalized eigenvalues, a conjugate pair to each 2 x 2 pencil. 

The FORTRAN subroutines DSUBSP and EXCHQZ allow one to update the 
decomposition (1) by postmultiplying Z; by Zz and premultiplying Qi by Q2 such 
that 


ABs = Az = Q2Qi(AB _ A)ZiZ2 (3) 
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is still in quasi-triangular form, but in addition, a specific ordering of generalized 
eigenvalues is obtained in this form. This is important in several applications [6, 
7]. Indeed, when the generalized ‘eigenvalues \1,..., An are ordered such that 
A1,..., A, are inside a region TI’ and Az+41,..., An are outside this region, then the 
space spanned by the first k orthonormal columns of Z = Z,Z2 is the deflating 
subspace [4] of \B — A corresponding to the spectrum inside I. In several 
applications, deflating subspaces have to be computed for different regions I’. Of 
course, I‘ has to be symmetric with respect to the real axis, since complex pairs 
of eigenvalues have to be categorized both outside or inside I‘ in order for this 
deflating subspace to be real. No further assumptions have to be imposed on I: 
it can be open or not, connected or not. 

The user has to provide a function describing the region I’ by testing whether 
the generalized eigenvalues of a 1 X 1 or 2 X 2 (diagonal) pencil lies inside or 
outside the region I. This function must be of the type 


INTEGER FUNCTION FTEST (LSIZE, ALPHA, BETA, S, P) 
with parameters: 


LSIZE_ An integer containing the size of the considered pencil (1 or 
2). 

ALPHA,BETA Two real variables. In case LSIZE=1, the generalized eigen- 
value of the considered pencil is given by ALPHA/BETA, 
which may be infinite when BETA=0. 

S,P Two real variables. In case LSIZE=2, they contain the sum 
and product of the two complex conjugate generalized eigen- 
values of the considered pencil. 

FTEST The function value, which is put equal to 1 when the gener- 
alized eigenvalue(s) of the considered pencil is (are) inside the 
specified region I’, and equal to --1 otherwise. 

Simple examples for such routines are given by the functions FIN, FOUT, 

FOLHP, and FCRHP, describing the regions inside and outside the unit circle, 

the open left half-plane, and the closed right half-plane, respectively. Their 

listings are included below as templates for the user. 

This routine is then used as parameter for the subroutine DSUBSP, which 
reorders the 1 X 1 and 2 x 2 diagonal pencils of the quasi-triangular form 4B, — 
A, such that those with generalized eigenvalues inside I appear first. The calling 
sequence for DSUBSP is 


CALL DSUBSP (NMAX, N, A, B, Z, FTEST, EPS, NDIM, FAIL, IND) 
with (parameters preceded by an asterisk are altered by the subroutine): 


NMAX An integer containing the first dimension of the arrays A, B, and Z. 

N An integer containing the current order of A, B, and Z. 

;axA,*B Doubly subscripted real arrays containing the pencil to be reordered. 
On return, \B — A contains the final quasi-triangular pencil, rearranged 
with respect to the region [' specified by FTEST. 

*7Z, A doubly subscripted real array into which the reducing column 
transformation is postmultiplied. 

FTEST The integer function provided by the user to describe the region I‘ of 
interest. 

EPS A real number used as the convergence criterion. Maximal accuracy is 
obtained when EPS is set equal to relpr X max{|| Al2, || B||2}, where 
relpr is the relative precision of the computer used. Smaller values of 
EPS will increase the amount of work without significantly improving 
the accuracy. 

*NDIM An integer giving the dimension of the computed deflating subspace. 

*FAIL A logical variable that on normal return is .FALSE. If the iterative 
part of the algorithm does not converge, FAIL is set to .TRUE.. 
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*IND An integer working array of dimension at least N. 

DSUBSP is to be used together with the EISPACK programs QZHES, QZIT, 
and QZVAL [1] to reduce a full pencil AB — A to quasi-triangular form with the 
eigenvalues inside the contour I appearing first on diagonal. (For the explanation 
of the parameters EPS1, TERR, ALPHAR, ALPHAI, and BETA in these 
routines, see [1].): 

CALL QZHES (NMAX, N, A, B, .TRUE., Z) 

CALL QZIT (NMAX, N, A, B, EPS1, .TRUE., Z, IERR) 

CALL QZVAL (NMAX, N, A, B, ALPHAR, ALPHAI, BETA, .TRUE., Z) 

CALL DSUBSP (NMAX, N, A, B, Z, FTEST, EPS, NDIM, FAIL, IND) 


Besides the function FTEST, describing the region I of interest, DSUBSP also 
uses the subroutines EXCHQZ, GIV, and SROT. EXCHQZ is a FORTRAN 
subroutine to interchange two adjacent (1 X 1 and/or 2 X 2) pencils of a quasi- 
triangular form. Specifically, it is supposed that A has a block of order /1 starting 
at the th diagonal element, and a block of order /2 starting at the (J + /1)th 
diagonal element (illustrated below for n = 5, / = 2, /1 = 2, 12 = 1): 


Ke EK OK oo Oy OR OY Ce 
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t I I 
B= xix x], As 1X X{ XxX xX (4) 
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X 4 X 


EXCHQZ constructs orthogonal row and column transformations V and W 
such that V(AB — A) W has consecutive blocks of order /2 and /1 at the /th 
diagonal element (illustrated for the example above): 
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The generalized eigenvalues associated with each diagonal block are interchanged 
along with the blocks. The column transformation W is postmultiplied into the 
array Z; the row transformation V is not stored since it is not required in the 
computation of bases of deflating subspaces. 

The calling sequence for EXCHQZ is 


CALL EXCHQZ (NMAX, N, A, B, Z, L, LS1, LS2, EPS, FAIL) 
with (parameters preceded by an asterisk are altered by the subroutine): 


NMAX An integer containing the first dimension of A, B, and Z. 


N An integer containing the current order of A, B, and Z. 

*A,*B Doubly subscripted real arrays containing the pencil to be reordered. 

*Z, A doubly subscripted real array into which the updating column trans- 
formation is postmultiplied.' 

L An integer containing the leading diagonal position of the first block to 


be interchanged. 
LS1 An integer containing the size of the first block. 
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LS2 An integer containing the size of the second block. 
EPS A convergence criterion (cf. EPS in the calling sequence of DSUBSP). 


*FAIL A logical variable that on normal return is .FALSE.. If the iterative 
part of the algorithm does not converge, FAIL is set to .TRUE.. 


EXCHQZ requires the subroutines GIV and SROT, which are elementary 
routines that construct and perform Givens rotations on column or rows. SROT 
is a BLA subroutine and GIV is a modification of SROTG of the BLAS package 
[2] in order to allow a more compact code for EXCHQZ, which contains several 
calls to these routines. 


2. METHOD AND PROGRAMMING DETAILS 


The subroutine DSUBSP makes a first pass through the diagonal blocks of the 
quasi-triangular form AB — A in order to determine the sizes of the diagonal 
blocks and the locations of their generalized eigenvalues with respect to [’. During 
this pass the integer vector IND(-) is created with entries +1 or +2. Here sign 
{IND(D] refers to the location of the generalized eigenvalues of block I with 
respect to I‘ (+ for inside I, — for outside T) and abs[IND())] indicates the size 
of this block. The entries of this vector are then rearranged such that the plus 
signs appear first. This is done using a “bubble sort,” that is, each time a plus 
sign follows a minus sign, it is moved in front of all its preceding minus signs via 
consecutive permutations. Each permutation, of course, involves an interchanging 
of two consecutive blocks using the subroutine EXCHQZ. 

EXCHQZ works in a fashion similar to the routine EXCHNG, developed for 
the reordering of the standard eigenvalue problem [5] (this is also the reason why 
an apparent parallelism with that paper has been pursued here). To interchange 
two consecutive blocks where at least one of them has order 1, a shift is performed 
to the real eigenvalue of a 1 X 1 block (in [5], this was only done for the 
interchange of two 1 X 1 blocks). Givens rotations are then constructed in a 
straightforward manner to interchange the shifted zero eigenvalue to the other 
block. The construction of the Givens transformations needed for the exchange 
of the blocks is done in such a way as to ensure backward stability. 

In the case of two 2 X 2 blocks, an arbitrary @Z-step is performed on both 
blocks in order to eliminate the uncoupling between them. Then a sequence of 
QZ-steps using a previously determined shift is performed on both blocks. A 
decoupling with the blocks in the desired order is usually obtained with a few 
steps (rarely more than two). If within 30 iterations no decoupling is obtained, 
the subroutine gives an error return. The criterion used is that the coupling 
element of the two blocks in the Hessenberg form of A is smaller than EPS. 
Since it does not make sense to force this coupling element to be smaller than the 
errors in the rest of the pencil, one should not choose EPS smaller than relpr x 
max{||A |l2, || B ||2}, where relpr is the relative precision of the computer used. A 
good choice for EPS is the “estimated” absolute precision of the (sometimes 
measured) data in A and B. Since the pencils used here are of dimension 4 x 4, 
the QZ steps are implemented with Givens transformations instead of House- 
holder transformations, which turns out to be economical. More details are given 
in [7], where a proof of the backward stability of the method is also given. 

EXCHQZ uses the routines GIV and SROT, which construct a 2 x 2 Givens 
rotation to zero out an element of a 2-vector, and perform it, respectively, on two 
columns or rows of a specified matrix. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 


ACM Algorithms Distribution Service .] 


SUBROUTINE DSUBSP(NMAX, N, A, B, Z, FTEST, EPS, NDIM, FAIL, IND) DSU 


INTEGER NMAX, N, FTEST, NDIM, IND(N) DSU 
LOGICAL FAIL DSU 
REAL A(NMAX,N), B(NMAX,N), Z(NMAX,N), EPS DSU 

DSU 


GIVEN THE UPPER TRIANGULAR MATRIX B AND UPPER HESSENBERG MATRIX A DSU 
WITH 1X1 OR 2X2 DIAGONAL BLOCKS, THIS ROUTINE REORDERS THE DIAGONAL DSU 
BLOCKS ALONG WITH THEIR GENERALIZED EIGENVALUES BY CONSTRUCTING EQUI-DSU 
VALENCE TRANSFORMATIONS QT AND ZT. THE ROW TRANSFORMATION ZT IS ALSO DSU 
PERFORMED ON THE GIVEN (INITIAL) TRANSFORMATION Z (RESULTING FROM A_ DSU 
POSSIBLE PREVIOUS STEP OR INITIALIZED WITH THE IDENTITY MATRIX). DSU 
AFTER REORDERING, THE EIGENVALUES INSIDE THE REGION SPECIFIED BY THE DSU 
FUNCTION FTEST APPEAR AT THE TOP. IF NDIM IS THEIR NUMBER THEN THE DSU 


C* NDIM FIRST COLUMNS OF Z SPAN THE REQUESTED SUBSPACE. DSUBSP REQUIRES DSU 
C* THE SUBROUTINE EXCHQZ AND THE INTEGER FUNCTION FTEST WHICH HAS TO BE DSU 
C* PROVIDED BY THE USER. THE PARAMETERS IN THE CALLING SEQUENCE ARE : DSU 
C* (STARRED PARAMETERS ARE ALTERED BY THE SUBROUTINE) DSU 
cx DSU 
Cx  NMAX THE FIRST DIMENSION OF A, B AND Z DSU 
c* N THE ORDER OF A, B AND Z DSU 
Cx  *A,*B THE MATRIX PAIR WHOSE BLOCKS ARE TO BE REORDERED. DSU 
Ck = -*Z UPON RETURN THIS ARRAY I$ MULTIPLIED BY THE COLUMN DSU 
cx TRANSFORMATION ZT. DSU 
cx FTEST(LS, ALPHA, BETA,S,P) AN INTEGER FUNCTION DESCRIBING THE DSU 
cx SPECTRUM OF THE DEFLATING SUBSPACE TO BE COMPUTED: DSU 
Cx WHEN LS=1 FTEST CHECKS IF ALPHA/BETA IS IN THAT SPECTRUM DSU 
cx WHEN LS=2 FTEST CHECKS IF THE TWO COMPLEX CONJUGATE DSU 
c* ROOTS WITH SUM S AND PRODUCT P ARE IN THAT SPECTRUM DSU 
c* IF THE ANSWER IS POSITIVE, FTEST=1, OTHERWISE FTEST=-1 DSU 
cx EPS THE REQUIRED ABSOLUTE ACCURACY OF THE RESULT DSU 
Cx  *NDIM AN INTEGER GIVING THE DIMENSION OF THE COMPUTED DSU 
cx DEFLATING SUBSPACE DSU 
Ck *FAIL A LOGICAL VARIABLE WHICH IS FALSE ON A NORMAL RETURN, DSU 
cx TRUE OTHERWISE (WHEN EXCHQZ FAILS) DSU 
cx  *IND AN INTEGER WORKING ARRAY OF DIMENSION AT LEAST N DSU 
cx DSU 
INTEGER L, LS, LS1, LS2, Ll, LL, NUM, IS, L2I, L2K, I, K, IT, DSU 

* ISTEP, IFIRST DSU 

REAL S, P, D, ALPHA, BETA DSU 

FAIL = .TRUE. psu 

NDIM = @ DSU 

NUM = @ DSU 
L=9@ DSU 

LS = 1 DSU 

C*** CONSTRUCT ARRAY IND(I) WHERE : DSU 
C&R IABS(IND(I)) IS THE SIZE OF THE BLOCK I DSU 
Cx** SIGN(IND(I)) INDICATES THE LOCATION OF ITS EIGENVALUES DSU 
Crk (AS DETERMINED BY FTEST). DSU 
C*x* NUM IS THE NUMBER OF ELEMENTS IN THIS ARRAY DSU 
DO 30 LL=1,N DSU 


L=L+ 15 DSU 
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IF (L.GT.N) GO TO 4@ DSU 52¢ 
Ll=L+1 DSU 530 

IF (L1.GT.N) GO TO 14 DSU 54¢ 

IF (A(L1,L).EQ.@.) GO TO 16 DSU 55@ 

C* HERE A 2X2 BLOCK IS CHECKED * DSU 560 
is, Sc2 DSU 57@ 

D = B(L,L)*B(L1,L1) DSU 58¢ 

S = (A(L,L)*B(L1,L1)+A(L1,L1) *B(L,L)-A(L1, L) *B(L,L1))/D DSU 59¢ 

P = (A(L,L) *A(L1,L1)-A(L,L1) *A(L1,L))/D DSU 660 

IS = FTEST(LS, ALPHA, BETA, S,P) DSU 61@ 

GO TO 2¢ DSU 620 

C* HERE A 1X1 BLOCK IS CHECKED * DSU 636 
16 LS =1 DSU 64¢ 

IS = FTEST(LS,A(L,L),B(L,L),S,P) DSU 650 

20 NUM = NUM+1 DSU 66% 

IF (IS.EQ.1) NDIM = NDIM + LS DSU 67¢ 
IND(NUM) = LS*IS DSU 686 

30 CONTINUE DSU 69¢ 
C*** REORDER BLOCKS SUCH THAT THOSE WITH POSITIVE VALUE DSU 760 


Cxx* OF IND(.) APPEAR FIRST. DSU 71¢ 
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1. INTRODUCTION 


Some of the work to be described is reminiscent of AARDVARK [5], an analysis- 
of-variance package, at Iowa State University in the early 1960s. This program 
was used for most of the large number of analyses processed at Iowa State at that 
time; however, the program was definitely not transportable, being written in a 
mix of assembler and FORTRAN for a nonstandard IBM 7074. Subsequent 
versions, lacking some of its initial capabilities but adding others, were prepared 
for other machines, including the IBM 360 (see for example [7]). One distinctive 
feature of the program that greatly aided in its usability was algebraic specifica- 
tion of the statistical model by the user [14], [18]. This facility has now become 
common in statistical packages. 

The initial AARDVARK relied principally on balanced analysis-of-variance 
(AOV) algorithms and approximate statistical methods were applied to treat 
unbalanced data. An iterative AOV algorithm was later developed by Hemmerle 
[12], which permits using balanced analysis-of-variance algorithms to obtain 
exact statistical results for unbalanced data. This algorithm along with subsequent 
work will be exploited in our development of a comprehensive analysis-of-variance 
algorithm for balanced or unbalanced data. 

Balanced analysis-of-variance algorithms frequently represent a level of ele- 
gance of logic that is difficult to surpass. One fine example is the algorithm due 
to H. O. Hartley [3], which obtains a complete factorial decomposition. Another 
is Wilkinson’s recursive algorithm [23]: Unfortunately, these algorithms are also 
frequently difficult to explain using straightforward notation; they are likely to 
involve matrices with complicated structures implicitly rather than explicitly. 
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Balanced analysis-of-variance algorithms normally do not require the coding of 
indicator variables, either externally or internally by the program. They possess 
the virtue of efficiency, both with respect to the number of operations performed 
and the amount of storage required. 

Data, on the other hand, are frequently unbalanced and are likely to have 
missing cells. Both theoretically and computationally, the order of complexity of 
analysis-of-variance problems increases down the following categories: 


(1) balanced data; 
(2) unbalanced data with no missing cells; 
(3) unbalanced data with missing cells. 


In some cases, the unbalanced data arise from a balanced design in which some 
of the observations are missing as a result of the experiment. Computationally, 
there are a number of missing data algorithms, notably Healy and Westmacott’s 
iterative algorithm [4] and Rubin’s noniterative algorithm [16], which essentially 
fill in the missing values for use with balanced algorithms. One could also use 
dummy covariates for each missing cell and then compute a balanced analysis of 
covariance. These approaches have the disadvantage that, in general, they require 
balancing all of the data (including the missing observations) to have equal cell 
frequencies. 

Almost all algorithms which seek to process unbalanced data with any degree 
of generality in an analysis-of-variance situation, including those in statistical 
packages, are matrix-oriented least squares or regression algorithms. These 
involve the creation of indicator variables, to cast the analysis-of-variance model 
as a regression model, and the formation of the design matrix Xp or the coefficients 
matrix of the normal equations X0'Xo. The normal equations are then solved 
using either orthogonalization or elimination methods. In some cases, SAS 
Procedure GLM [1], for example, an explicit G-inverse is obtained for Xo’Xo. One 
problem with the matrix-oriented approach is that the dimensions of Xo or Xo’Xo 
can be overwhelming for moderate to large analysis-of-variance problems. This 
approach is also extremely inefficient when the data are balanced. 


2. FEATURES AND DESIGN OBJECTIVES 


In what follows, we describe a global algorithm for the analysis of variance with 
the following features. 


(1) Balanced data, unbalanced data, and unbalanced data with missing cells 
are all processed by the algorithm. This is accomplished without losing the 
operational efficiencies obtainable from balanced data and without applying 
approximate statistical methods to the unbalanced data. 

(2) The algorithm is very general with respect to the kind of problems it can 
handle. Specifically, it bases its calculations upon an algebraically specified 
analysis-of-variance model of the type discussed in Searle [19]. This includes 
models with crossed factors, nested factors, and interactions between factors. 
This general model, along with the facility to handle missing cells, also includes 
such designs as incomplete blocks, lattices, and Latin squares. 

(3) Very large problems may be processed using a relatively small amount of 
computer storage. With one minor exception, no matrices are stored and no 
explicit matrix operations are performed. In particular, neither Xo nor XoXo is 
stored or computed. An exact G-inverse solution to the normal equations is 
obtained without ever computing a G-inverse. The rank of the design matrix Xo 
is obtained from the pattern of missing cells without explicit operations on Xo. 

(4) The algorithm provides a heuristic optimum of maximizing analysis-of- 
variance capabilities while minimizing lines of source code. Since a principal 
attribute of the algorithm is its limited demands for array storage, an effort was 
made to also constrain program storage through a judicious selection of functional 
capabilities and the production of tight code. Consequently, the algorithm should 
be well suited for use on small computers. 
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(5) The user is given reasonable facilities in specifying his analysis-of-variance 
problem algebraically and various options alphanumerically in an essentially 
format-free manner. 

(6) The algorithm is well suited to interactive usage. It was developed using 
CALL/OS at the University of Rhode Island and TSO (time-sharing option) at 
North Carolina State. It may, of course, also be used as a batch program. A mode 
parameter, interactive or batch, determines the nature of prompting, I/O, and 
error returns. . 

(7) The program has been written in American National Standard Basic 
FORTRAN for portability. The program has been verified by the Bell Labora- 
tories PFORT verifier [17] and should run on any computer supported with a 
FORTRAN 66 compiler. With the exception of using the Hollerith data type in 
DATA statements, the program is also compatible with FORTRAN 77. 


Along with the effort to constrain program storage, steps were taken to reduce 
the number of lines of source code. Lines of source (including COMMENT 
statements) can be a limiting factor with respect to file storage in interactive 
systems. Most of the following measures served to reduce program storage as 
well as lines of source code: limiting the number of specification statements, 
WRITE statements, FORMAT statements, and unnecessary CONTINUE state- 
ments; limiting the amount of constant alphanumeric information in FORMAT 
statements; using selective, concise COMMENT statements; accepting trivial 
operational inefficiencies which reduce lines of source code; avoiding modularity 
not contributing to operational efficiency or storage reduction; and using single- 
character identifiers when possible. The portability objective essentially limits 
one to storage of a single alphanumeric character per alphanumeric constant or 
array location. Rather than use additional code to interpret multiple-character 
identifiers, for such things as specified options, we limit these to one character. 

As a consequence of these measures, the complete program for the global 
algorithm consists of 8836 FORTRAN statements exclusive of COMMENT state- 
ments. The object code produced by the WATFIV compiler was contained in 
36,656 bytes. In addition, the program was written in such a manner that several 
of the functional capabilities may easily be deleted, if necessary, to relax program 
storage. 


3. CONSTITUENT ALGORITHMS 


We have called the algorithm under discussion a global algorithm, since it 
encompasses the use of several independent algorithms. The principal indepen- 
dent algorithms, which comprise the global algorithm, are the following. 


3.1 The Iterative AOV Algorithm 


This algorithm iteratively applies expectation and residual operators (E/R oper- 
ators) for balanced data to obtain exact results for unbalanced data. In other 
words, stated simply, the algorithm computes an analysis of variance for unbal- 
anced data by successive computation of balanced analyses. Since the algorithm 
uses balanced E/R operators to obtain its results, there is no need to create 
indicator variables or form the design matrix Xo or Xo’'Xo. The algorithm operates 
upon a vector of cell sums and a vector of cell frequencies rather than upon a 
(potentially large) matrix so that array storage requirements are minimal. Missing 
cells are handled routinely and convergence of the algorithm is guaranteed [12]. 
A useful monotonic property serves to limit iteration when testing hypotheses. A 
balanced analysis of variance is a special case requiring only one iteration. 

The basic algorithm [12] is very general and applies to any analysis of variance; 
however, one must know or determine the balanced E/R operators. It is in this 
context that one can apply much of the algorithmic lore associated with balanced 
analyses. An initial implementation using a relatively comprehensive class of 
balanced E/R operators was discussed by Hemmerle and Piette [6]. Many of the 
features of the global algorithm were included in this implementation; however, 
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certain unnecessary rank restrictions were placed upon the design matrix Xo. The 
latter restrictions were subsequently removed by Hemmerle [10], who showed 
that with proper parameter selection the iterative AOV algorithm would obtain 
a G-inverse solution to the normal equations for any design matrix. An improved 
iterative approximation, which halves the number cf iterations in testing hy- 
potheses, is also given in [10] and is used here. 

An iterative analysis of covariance algorithm was also developed by Hemmerle 
[11] as an extension of the iterative AOV algorithm. Although this covariance 
algorithm adapts well:to the logic of the global algorithm and is array storage 
efficient, covariance capabilities were excluded here principally because of the 
additional program storage requirements. 


3.2 An Iterative Rank Algorithm 


With unbalanced data, including missing cells, the ranks of the design matrix and 
restricted. design matrix must be computed to determine degrees of freedom for 
F statistics. Algorithms have been included (Section 3.5) to determine rank 
noniteratively from the pattern of missing cells for a given model when possible. 
When this cannot be accomplished, a recent adaptation of the iterative AOV 
algorithm is used to compute rank in one of two ways, depending upon the 
number of missing cells. Either way will produce monotonically increasing con- 
vergence to the integer rank value. For a small number of missing cells we use 
some matrix storage (the exception cited earlier) and obtain monotonically 
increasing quadratic convergence. Both methods are outlined in a subsequent 
section. A complete discussion is given in [9]. 


3.3 A Balanced Factorial Decomposition Algorithm 


The technique for computing a balanced analysis of variance based upon a 
factorial decomposition of linear combinations of classifications means dates back 
to H. O. Hartley [8]. 

We use the algorithm described in Hemmerle [13, pp. 180-185] to obtain this 
decomposition. A one-to-one correspondence is maintained between the distinct 
arrays in this decomposition and the locations of an E/R list which we shall 
discuss shortly. 


3.4 A Pooling Algorithm 


In order to construct the E/R operators needed for the iterative AOV algorithms, 
we must “pool” (add together in the proper manner) distinct arrays in the 
factorial decomposition as dictated by the particular analysis-of-variance model. 
The complete factorial decomposition will be stored in a single linear, one- 
dimensional array, and we must be able to map one of the distinct arrays within 
this. decomposition into another. We use essentially the same algorithm described 
in Schlater and Hemmerle [18] to do the mapping and pooling; however, we pool 
arrays of the decomposition rather than classification means, as do the latter. 


3.5 Algorithms to Recognize Balance and Restructure Data 


A balanced analysis of variance is a’special case for the iterative AOV algorithm. 
When properly executed, final results will be obtained on the first iteration. 
Furthermore, iterative rank computations are unnecessary. With unbalanced 
data, there are also frequent situations in which sorne of the results may be 
obtained noniteratively. An example would be a full factorial model; the rank of 
the design matrix, the sum of squares for error (SSE), the sum of squares for 
regression (SSR), and a G-inverse solution to the normal equations may all be 
obtained from a balanced analysis of variance on cell means [12]. Also, when 
testing an hypothesis involving unbalanced data, the data structure for the model 
restricted by the hypothesis frequently has fewer dimensions than it has for the 
full model. A simple restructuring of the data may facilitate obtaining results 
without iterating. Essentially, this involves creating a surrogate vector of cell 
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frequencies based upon reduced dimensions for the same data; however, duplicate 
entries are made in this surrogate vector to maintain a proper one-to-one 
correspondence with the original vector of cell sums. Several algorithms have 
been incorporated into the global algorithm to recognize balance and restructure 
data, when appropriate, to avoid unnecessary iteration. The related theory and 
a description of the algorithms willbe found in [8]. 


3.6 An E/R List Construction Algorithm 


Numeric calculations in the global algorithm are driven by what we have called 
an E/R list. If there are n factors in the full analysis-of-variance model, then the 
E/R list will have 2” entries corresponding to the 2” terms (mean, main effects, 
and interactions) in a full factorial model. The E/R list is constructed by scanning 
or parsing an algebraic model statement. Numeric entries are made in the list 
which uniquely describe the model. Following the procedure suggested by Hem- 
merle [14], decreasing powers of 2 are assigned as numerical values to factor 
symbols and their associated a with unity for the last factor and its 
associated subscript. 

The sum of the numerical values:of the factor symbols (plus one) is computed 
for each term in the model. For crossed factors or interactions between crossed 
factors, this sum is entered in the corresponding location of the E/R list. For 
nested factors or interactions involving nested factors, multiple entries are made 
in the E/R list. The sum is entered into each location of the E/R list which 
corresponds to an array in the factorial decomposition which must be pooled (see 
[13, pp. 174-176]). The algorithm determines these locations from the numerical 
values of the factor symbols and subscripts in the model term. Examples will be 
given later in the sequel. 

An hypothesis statement indicates those terms in the full model which should 
be deleted in forming the reduced model. As this statement is parsed, the E/R 
list entries for the model terms in the statement are made negative. The R 
operator is then always formed by pooling the arrays in the factorial decomposi- 
tion associated with zero or negative E/R list entries. 


4. STATISTICAL FOUNDATIONS AND COMPUTATIONS 


Analysis-of-variance models tend to create confusion because of the fact that in 
the form they are usually written, these models are overparameterized. For 
example, the two-way classification with interaction is usually written as 


Vik = + Ai + 6; + abi + exp, 
i=1,...,4 J=1,...,d, kR=1,..., nj. (4.1) 


With e;;, distributed N(0, o”) and o”? unknown. None of the parameters p, ai, b;, 
or ab; in (4.1) are estimable (for any i or 7), even though the data may be 
balanced. That is, although the normal equations for (4.1) are consistent, there is 
no unique solution for these equations. We may obtain a unique solution by 
imposing constraints or side conditions upon the solution. These conditions have 
no effect upon what is estimable from the data for the model; however, they do 
have a bearing upon the hypothesis that is tested by applying the same applicable 
conditions to a reduced model. 

Speed and Hocking [22] discuss the resulting difference in the application of 
Searle’s R ( ) notation [19] to the initial, overparameterized model as opposed to 
a reparameterized model obtained by imposing conditions on the original model. 
They refer to the latter as R* ( ) or procedure 2. Speed et al. [21] survey the 
hypotheses being tested by current. computational methods and computer pro- 
grams. A significant by-product of this work is that, when using procedure 2, the 
unweighted summation constraints (e.g., Yi ai = Dy 0; = Yi abi; = Yj abi; = 0) 
yield the most likely hypotheses of interest, the classical Yates hypotheses [24]. 
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The global algorithm uses procedure 2 with the unweighted summation con- 
ditions. In matrix form, the full reparameterized model is given by 


y= XP +e (4.2) 


where y is a vector of N observations; Xo is an N X p naatrix of —1, 0, 1 indicator 
variables consistent with the unweighted summation conditions; f is a vector of 
Pp parameters; and the elements of e are distributed N(0, o”). 

Note that the p parameters in £ will be linear combinations of the parameters 
appearing in the overparameterized model. As an example, consider the two-way 
classification without interaction. We have that 


B’ = (pt+a.+ 6. a,-—a@,...,ar-1—a., bi — By woes by-1 -- 6.) (4.3) 


with the dot notation denoting a mean. If Xo has full rank, then all of the elements 
of £ are linearly independent estimable functions. A fact that sometimes causes 
confusion is that a; — a. and b,; — 6b. are also estimalhle in the above example; 
however, they are not linearly independent of the elements in 8. We mention this 
fact here since the global algorithm yields a G-inverse solution for the initial 
overparameterized model as well as a G-inverse solution for (4.2). These solutions 
are the same, except for the inclusion of additional nonlinear independent 
elements in the former solution. 

In order to consider hypothesis testing, we partition the design matrix Xo for 
the full model as [Xo1 | Xo2], where Xo: is N X k, and write the model (4.2) as 


y = Xo1hi + Xo2Pe + e. (4.4) 
The global algorithm will attempt to test the hypothesis 
Ho: B2 = 0 (4.5) 


by fitting the reduced model 
B) Xoifhi +e. (4.6) 


The hypothesis statement specifies the model terms which are to be deleted from 
the full model in forming the reduced model (4.6). For balanced data or unbal- 
anced data with no missing cells, these are the same hypotheses tested, with F 
statistics, in a standard balanced analysis-of-variance table. A rule is given in [9] 
to determine whether or not the equivalent balanced data hypothesis is testable 
for unbalanced data with missing cells. For a model with all factors crossed, this 
rule is simply: the equivalent balanced data hypothesis is testable if and only if 
the rank of the full model minus the rank of the reduced model equals the degrees 
of freedom one would use for the hypothesis with balanced data. It is the author’s 
opinion that when the equivalent balanced data hypothesis is not testable, those 
hypotheses that are testable are usually very difficult to interpret in a meaning- 
ful way. 

Some designs which are considered to be balanced designs will require iteration 
because the residual operator used applies to a more general model. An example 
of this is a Latin square which the algorithm treats as a missing cell problem. 
Iteration will be necessary to obtain SSE for the full model; however, as a result 
of data restructuring, iteration is not required in testing the relevant hypotheses. 

The following statistics may be obtained from the algorithm, most of them on 
an optional basis: 


(1) cell sums, frequencies, and means; 

(2) classification sums, frequencies, and means; 

(3) rank (Xo); 

(4) SSE (full model) = y’[I — Xo(X0X0) Xo |y (invariant); 
(5) SSR (full model) = y’Xo0(X0.X0) Xoy; 


A 


(6) a G-inverse solution to X bXoh = Xoy; B = (X0X0) X09; 


A 


(7) estimates of expected cell means = Xo (invariant); 
(8) rank (X01); 
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(9) SSE (reduced model) = y’[I — Xo1(X01X01) X01] 3 
(10) SSR (reduced model) = y’Xo1(X61.X01) X01 93 
(SSR(full) — SSR(reduced))/(rank(Xo) — rank(Xo1)) | 
SSE(full) /(N — rank(Xo)) . 


(12) probability values; Prob{F'| Ho}. 


(11) F= 


We indicated earlier that a G-inverse solution is obtained for the overparameter- 
ized model as well. It should be clear that the rank of Xo is the same as the rank 
of the design matrix of the overparameterized model formed using 0, 1 indicator 
variables. 


5. LOGICAL COMPONENTS 


The program for the global algorithm consists of a main program and eight 
subroutines. The principal function of these components is described below. 

MAINA processes the factor, level statement; computes cell sums, cell fre- 
quencies, and y’y as it reads the data; processes the options statement and 
contains much of the code to execute the A (cell means) and C (classification 
means) options. 

SCAN processes the model and hypothesis statement to construct (or modify) 
the E/R list; computes parameters needed in restructuring data; computes the 
degrees of freedom applicable to data with no missing cells. 

IGET is used by the main program and subroutine SCAN to sequentially 
retrieve characters (other than blank, plus, or comma) from the input buffer. 

PART1 restructures the data (cell! frequencies) when appropriate; checks for 
balance and alternative noniterative computations; computes rank noniteratively 
if possible or iteratively otherwise when the R (rank) option is specified. 

PART72 is the principal numeric computational component; with the use of the 
remaining four subroutines, it computes SSE, SSR, estimates of expected cell 
means, a G-inverse solution to the normal equations, F statistics, and probability 
values. 

STEP performs one basic step of the iterative AOV algorithm [12] using the 
improved approximation for SSR given in [10]. This basic step consists of the 
following substeps. 


(1) A<—(Y—-D-V)/e 
(2)V<eV+A 
(3)B<—B+A 
(4) A —R[A] 
(5) Ve—V—-A 
(6) S —2-Y’/V— V’DV 


where 


Y is the vector of cell sums, D is the diagonal matrix of cell frequencies stored as 
a vector, and c is an algorithm constant set to assure convergence and, in 
hypothesis testing, to assure monotonicity of the approximation S to SSR; 

A, B, and V are work vectors of size n., with n. being the number of cells. An 
additional work vector large enough to contain the factorial decomposition 
cited earlier is also required; however, vector A will occupy the first n, locations 
of this additional vector; 

R{A] is the residual operator applied to vector A. Substep (4) above consists of 
a factorial decomposition of vector A, followed by pooling the appropriate 
arrays of the decomposition back into A. 


The vectors B and V must be initially set to zero. Upon completion, perhaps 
after many steps, estimates of the expected cell means will be contained in V, and 
a G-inverse solution is obtained by applying the E operator to the vector B. 
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Substep (1) above is modified slightly for iterative rank computations and for 
restructured data. In computing rank, this takes the form 


A<(Y- AV), 


where A is a diagonal matrix with unit diagonals for filled cells and zero diagonals 
for missing cells. Operations with A are handled implicitly and this matrix is never 
stored. In performing noniterative calculations (a single step) on restructured cell 
frequencies, substep (1) is modified to 


A<(D2°-Y—V) 


where D2” is a diagonal G-inverse of the diagonal matrix of restructured cell 
frequencies [8]. 

Substep (6) above must also be modified in computing rank iteratively with A 
replacing D. Furthermore, in rank computations, the vector Y contains a dummy | 
unit vector; cell sums have been temporarily stored elsewhere in a vacant vector. 


DECOMP obtains a factorial decomposition of a given vector; determines the 
classification frequencies needed in PART to restructure data; computes clas- 
sification means for the C option in MAINA. 


POOL either moves the secondary array into the primary array, duplicating 
entries where needed, or it pools the secondary array into the primary array by 
addition. 


LABEL calculates the array of coefficients for the array map needed in pooling; 
produces output labels for classification means and for the G-inverse solution. 


Of these logical components, all of PART1 may be deleted to further reduce 
program storage without making PART2 inoperable; however, this would make 
the program less efficient owing to unnecessary iteration and full rank would be 
assumed by default for Xo or Xo:;. Almost all of SCAN can also be deleted, 
provided the user constructs and inputs the required E/R list. 


6. ARRAY STORAGE 


We previously emphasized the storage efficiency of the algorithm for moderate to 
large problems. Fundamentally, this efficiency is attributable to the use of the 
iterative AOV algorithm; however, array storage economy was also stressed in 
constructing the global algorithm. The following is a brief description of all of the 
arrays included. 


LSTFI is the array discussed in [13] and [18], which is used in formation and 
subsequent manipulation of the arrays in the factorial decomposition; this is an 
array of size 2”, where n is the number of factors. 

LER is the E/R list that is also of size 2”. 

LE is an alphanumeric array for factor symbols of size n. 

LS is an alphanumeric array of associated subscripts of size n. 

LV is an array of the numerical values assigned to the factor symbols and their 
associated subscripts; it also has size n. 

LLIM contains the number of levels for each factor and is of size n. 

LT is a temporary work array of size n. 

LP is also a work array; however, its size is 10, the maximum number of factors 
handled by the program. 

LD is an alphanumeric array of size 10 containing the digits 0-9; this array is 
used to convert alphanumeric input, such as the number of levels for a factor, to 
numeric. 

LO is an alphanumeric array of size 10 containing the single-character option 
identifiers. 

IA is an alphanumeric input buffer—a card image—-which is used in processing 
the factor, levels, options, model, and hypothesis statements and also for storage 
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Table I. Options 


Identifier Function of option Default 
S(d) Significant digits in results d=5 
T(Z x 10%) Test level 1= 0.05 
I(m) Iteration maximum m = 100 
R Rank computations (iterative) off 

V Estimates of expected icell means off 

G G-inverse solution to normal equations off 

P Probability values for F statistics off 

Z Intermediate output off 

A Cell sums, frequencies, and means off? 

C Classification sums, frequencies, and means off? 


“ These switches do not change their status each time the option is specified. 


of a variable FORMAT statement for input data. (The model and hypothesis 
statements have continuation facilities.) 

Q is the only two-dimensional array. It is used exclusively for rank computations 
and its size, in relation to the number of missing cells, determines the rank 
algorithm applied. If the dimension of Q were fixed at 10 x 10, then the 
quadratically convergent rank algorithm would be used only if there were no 
more than 10 missing cells. 

QT is a vector whose size is the same as one of the dimensions of Q; it is used 
in conjunction with Q in computing rank. 

W is a linear array that is used for all the numeric computations. This array 
logically consists of six contiguous vectors. The implicit names of these vectors 
coincide with those used in describing a step of the iterative AOV algorithm; they 
are ordered in storage as 


Y, D, i V, B, A. 


The first five of these vectors have size n., where n, is the number of cells. The 
sixth vector is the size of the factorial decomposition for the problem. For 
example, with two factors we have n. = IeJ, while the vector A has size 
(I + 1)(J + 1). Ordinarily, the array W would be allocated all of the remaining 
computer storage; the implicit variable dimensioning of W maximizes the number 
of analysis-of-variance problems that can be processed within a given amount of 
storage. 


7. THE FACTOR, LEVELS STATEMENT 


The factor, levels statement creates entries for the arrays LE, LS, LV, and LLIM. 
The array LSTFI is then formed from LLIM. Factor symbols, subscript symbols, 
and factor levels are included in the statement; the number of factors and their 
numerical values are determined. Asian example of a factor, levels statement, 
consider an analysis involving 3 factors with levels 5, 10, and 15. If we decide to 
name the factors R, C, T with subscripts I, J, K, then the statement would be 
written (typed/punched) on one line as 


F(R, C, T), L(1(5), J(10), K(15)) 


All of the commas above are cosmetic, as are blanks and pluses; the same 
statement could be written as 


F(RCT)L(1(5)J3(10)K(15)) 


8. OPTIONS AND THE OPTIONS STATEMENT 


A list of option identifiers and default values is given in Table I. The first three 
identifiers include an argument enclosed within parentheses which are used to 
modify a parameter. The remaining seven identifiers trigger on/off switches; with 
the exception of the A and C option, these switches change their status each time 
the option is specified. 
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The S option sets the relative iterative tolerance for SSR by forming the test 
constant 0.05 x 10°? x (y’y). Iteration ceases when two successive approximations 
to SSR differ in magnitude by less than this test constant. This approach in 
practice seems to provide at least the requested accuracy in results obtained 
iteratively. A specification of d = 0 results in the skipping of all calculations in 
PARTz2 and thus provides an option for independent rank calculations. 

The T option sets the probability level at which F tests will be conducted. 
When iterative calculations are necessary for hypothesis testing, the constant c 
of the iterative AOV algorithm [12] is selected such that the sequence of 
approximations to the F statistic will be monotonically decreasing. The approxi- 
mation given in [20] is used to compute the probability level for the F approxi- 
mation. Whenever this value falls below the level specified, iteration ceases due 
to lack of significance. In the event that this value stays above the level specified, 
iteration continues until two successive F approximations differ by less than 
0.005. When the P option is specified, iteration is continued for nonsignificant F’s 
as well, in order to also obtain final probability levels for these statistics. 

The R option must be in on status to compute rank iteratively. Noniterative 
rank computations in PARTI are not affected by this option. The terminal 
iterative approximation to rank need not be highly accurate since the approxi- 
mations converge monotonically to an integer; furthermore, absolute rather than 
relative cutoff tolerances may be used. Although the preset values for these 
tolerances may be modified, they have been tested to obtain the correct rank 
with minimal iteration. 

The method best suited to a relatively small number of missing cells involves 
computing powers of a matrix whose order is the number of missing cells. The 
initial matrix is formed noniteratively. Successive powers, 1, 2, 4, 8, ..., of this 
matrix are formed in the array Q. The trace of the matrix in Q converges 
quadratically and monotonically to the rank of Xo. In this case, we cease iteration 
when successive traces differ by less than 0.1. The rank is taken as the next 
integer. The method best suited to a large number of missing cells applies the 
iterative AOV algorithm to dummy unit vectors for each filled cell with D 
replaced by A. The sum of the SSRs obtained for each unit vector will equal the 
rank of Xo. In this case, we cease iteration when two successive approximations 
to SSR for a given unit vector differ by less than 0.1/n¢ where n; is the number of 
filled cells. This method will be expensive timewise when n; is large. 

When the Z option is on, the following intermediate output is produced when 
applicable: the current E/R list; the successive traces of the matrix in array Q or 
the cumulative sum of the SSRs for unit vectors in computing rank; the approx- 
imations to SSR for the full model; the approximations to SSR for the reduced 
model of the hypothesis. 

Although the A and C options may appear to be somewhat mundane, these 
options require no additional array storage and they require little additional code; 
furthermore, it is likely that they would be requested as part of an analysis of 
variance. 

An option statement is written on one line as a string of selected identifiers 
enclosed in parentheses and preceded by an O. The identifers may be in any 
order. For example, with the R and Z options in off status, to specify eight 
significant digits of accuracy, iterative rank computations, and intermediate 
output, the options statement may be written as 


OR, S(8), Z) 


where the commas are again cosmetic. 


9. MODEL AND HYPOTHESIS STATEMENTS 


Examples of the model and hypothesis statements for three factors are given in 
Table II along with the E/R list entries that would be produced for these 
statements. These examples assume that factor symbols A, B, C, and subscript 
symbols I, J, K were used in the factor, levels statement. The analysis-of-variance 
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Table II. Model and Hypothesis Statements 


Statements E/R list 

(yijne = b+ a; + b, + Ch + ijn) ABC AB AC A BC B CM 
M + A() + B(J) + C(K) Sees: o| 3 

H BU) -3 | 2|1 
(Vigne = w+ ai + bij + Cie + Cijnd ABC AB AC A BC B Cc M 
M + AQ) + BJ) + C(JK) 1 
(Viet = B+ ai + Bij + Ch + ACR + Cijnd) ABC AB AC A BC B CM 


M + A() + BJ) + C(K) + AC(IK) | o | af eis] o ae 2] 1 
H AC(IK) Oe lf 8 [=e [6] 0 2 || 


(vizat = B+ ag + dy + abiy + Cizn + Ciyn0) ABC AB AC A_ BC B_ CM 
M + Ad) + BW) + ABC) + C(IJK) 
H AB(IJ), C(IJK) 


model, as it is usually written, appears above each model statement in Table II. 
Notice that the variate yi; and the error term ej; do not appear in the model 
statement. The additional subscript / is also implicit; that is, the number of 
observations in the (i, 7, 2) cell depends upon the data. The rules for constructing 
the model statement basically parallel those used in [14] and [18]: the associated 
subscript of a factor must always appear along with the factor symbol in a model 
term; if a factor is nested, it must be nested within a factor or factors appearing 
to the left of it in the factor, levels statement; the ordering of the associated 
subscripts in the factor, levels statement must correspond with the ordering of 
the data. As indicated earlier, pluses, blanks, and commas serve only to improve 
the appearance of these statements; these characters are ignored in parsing. 
Should either the model or hypothesis statement require more than one line (or 
card), continuation to the next line is indicated by placing a slash (/) after the 
last model term in the current line. For example, the fourth model statement in 
Table IT could be written as 


M + AQ) + BJ) + AB(J)/ 
+ C(IJK) 


As a convenience, a full factorial model may be specified as M*, an asterisk 
following M. Hypothesis statements are then written normally using the same 
symbols appearing in the factor, levels statement. The E/R list construction 
algorithm includes the logic necessary to detect invalid models or hypotheses 
incorrectly specified. During interactive use, corrections can be made when an 
error is detected. 

Any number of models may be applied experimentally to a given set of data. 
This includes models with fewer factors than appear in the factor, levels state- 
ment; the data will automatically be restructured for such models. 


10. FLOW OF CONTROL 


Flow of control proceeds in the following manner: 


(1) factor, levels statement, 

(2) variable FORMAT statement, 

(3) data, 

(4) blank line (card), 

(5) options statement/model statement/hypothesis statement/blank line/E. 


The data are prepared with one observation per line and cell indicators preceding 
the observation; the variable FORMAT statement must reflect this order. Cell 
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indicators are the factor levels for the observation. There is no indicator for 
within cell replication and no entries are made for missing cells. A check on 
lexicographical ordering of indicators is included; however, this check is easily 
deleted if inconvenient. 

Once the data have been entered, control is centered upon (5). Any number of 
options, model, or hypothesis statements may be entered in any order (except 
that a model statement must precede any hypothesis statements). Entering a 
blank line returns control to (1); entering the character E, for end, will terminate 
processing. 


11. EXAMPLE 


We present here a simple example, processed in batch mode, to illustrate many 
of the features of the global algorithm. There are three factors A, B, and C with 
levels of 3, 2, and 2, respectively; this information is conveyed in the initial factor, 
levels statement. The data are unbalanced and three cells—cells (1, 1, 2), (2, 1, 2), 
and (2, 2, 1)—are empty. 

After the data have been read, the first option statement is entered requesting 
intermediate output and specifying the A, C, and R options. Summary statistics, 
computed immediately for the A and C options, are printed followed by the 
current status of the options, including default values. A model statement repre- 
senting a model with three crossed factors A, B, and C and an interaction between 
factors A and B is entered; the corresponding E/R list is printed as intermediate 
output. Intermediate output of rank computations for the design matrix for the 
full model follows, with each iteration displaying the trace of the matrix in Q, 
until the rank of 7 has been determined. SSR for the model is next computed 
iteratively to approximately five significant digits with intermediate output 
printed for each iteration. 

An hypothesis statement is entered to test the significance of factor C. The 
algorithm determines the rank of the design matrix for the reduced model to be 
six noniteratively; it also restructures the data and computes SSR noniteratively 
for the reduced model. The computed F statistic is found to be not significant at 
the 5 percent level. Another hypothesis statement is entered to test the hypothesis 
of no AB interaction. Again the algorithm determines rank noniteratively; how- 
ever, it must iterate to determine SSR for the reduced model. Intermediate 
output of the monotonically increasing approximation to SSR is printed until the 
corresponding approximation for F falls below the 5 percent level on the second 
iteration. ; 


=(A,B,C) LC1(3),39(2) ,K(2)) 
DATA FORMAT AND INPUT DATA- 
(1X, 312,F4.1) 


112.2 
1112.8 
1213.1 
1224.5 
211 2.4 
2112.7 
222 2.6 
2225.2 
3114.5 
3123.6 
3°21 5.0 
3223.7 
00. .0 
0(Z,A,C,R) 
C=LL SUMS, FREQUENCIES, AND M-ANS- 
CELL SUM FREQ. MEAN 
} -50000000e+01 2. .25000000e+01 
2 (MISSING CELL) 
3 -31000000e+01 1. -31000000e+01 
4 -45000000e+01 l. -45000000e+01 © 
5 -51000000e+01 2. -25500000e+01 
6 (MISSING CELL) 
7 (MISSING CELL) 
8 .78000000e+01 2. -39000000e+01 
9 -45000000e+01 Ll. -45000000e+01 
10 -36000000e+01 1. -36000000e+01 
ll -50000000e+01 1. -50000000e+01 
12 -37000000e+01 l. -37000000e+01 
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CLASSIFICATION SUMS, FREQUENCIES, AND MZ ANS- 


IJ. 
1 -50000000e+01 2. -25000000e+01 
2 -76000000e+01 2. -38000000e+01 
3 -51000000e+01 2. -25500000e+01 
4 .78000000e+01 2. .39000000e+01 
5 .8100000028+01 2. -40500000e+01 
6 -87000000e+01 =2. -43500000e+01 
I.K 
1 .81000000e4+01 3. .27000000e+01 
2 -45000000e+01 = 1. -45000000e+01 
3 -51000000e+01 2. -25500000e+01 
4 -78000000e+01~ = 2. -39000000e+01 
5 -95000000e+01 2. -47500000e+01 
6 .73000000e+01 = 2. -36500000e+01 
I. 
1 .12600000e+02 4. -31500000e+01 
2 .12900000e+02 4. .32250000e+01 
3 -16800000e+02 4. -42000000e+01 
. IK 
1 .14600000e+02 =5. .29200000e+01 
2 .36000000e+01 1. -36000000e+01 
3 -81000000e+01 2. -40500000e+01 
4 .16000000e+02 4. -40000000e+01 
ial 
1 -18200000e+02 6. .30333333e+01 
2 -24100000e+02 6. -40166667e+01 
K 
1 .22700000e+02 7. .32428571e+01 
2 .19600000e+02 ~=5. -39200000e+01 
1 -42300000e+02 12. .35250000e+01 


OPTIONS- S= 5, T= .0500, I=100, 
M+ A(I)+B(J)+AB(II9)4+C(K) 


R=1, V=0, G=0, P=0 


E/R LIST- 

0 7 0 5 0 3 2 dL, 
ITERATION O, TRACE = 5.250000000 
ITERATION 1, TRACE= 5 .937500000 
ITERATION 2, TRACE= 6.558593750 
ITERATION 3, TRACE = 6.892074585 
THE RANK OF THE M DESIGN MATRIX IS = 7 
ITERATION 1, SSRM= -11689479e+03 
ITERATION 2, SSRM= -14589862e+03 © 
ITERATION 3, SSRM= -15314517e+03 
ITERATION 4, SSRM= -15495693e+03 | 
ITERATION 5, SSRM= .15541004e+03 
ITERATION 6, SSRM= -15552343e+03 © 
ITERATION 7, SSRM= -15555187e+03 . 
ITERATION 8, SSRM= -15555904e+03 
ITERATION 9, SSRM= -15556089e+03 
ITERATION 10, SSRM= -15556138e+03 
ITZRATION 11, SSRM= -15556153e+03 
ITERATION 12, SSRM= -15556158e+03 | 
ITERATION 12, SSR(FULL MOD=L)= .15556158e+03, 

SS (FULL MODEL)= .57284167e+01 
H C(K) 
E/R LIST- 


591-P13- 


0 


a) 7 a) 5 0 ne S| 
THE RANK OF THE H DESIGN MATRIX IS 6 


FROM RANK COMPUTATIONS- D® (NUM)= 1, OF (DEN)= 5 
ITERATION 1, SSRH= .15545500e+03 
ITERATION 1, Fe .093 , PROB(F) .GT. .7633 VS. F LEVEL OF .-0500 
SSR(RE DUCED MODEL)= .15545500e+03 
H AB(IJ) 
£/R LIST- 


0 -7 0 5 0 3 2. 1 
THE RANK OF THE H DESIGN MATRIX IS. 5 
FROM RANK COMPUTATIONS- DF (NUM)= 2, OF (DEN)= 5 
ITERATION 1, SSRH= -11623292e+03 : 
ITERATION 2, SSRH= -14498170e+03 
ITERATION 2, Fe 4.617 , PROB(F) .GT. .0734 VS. F LEVEL OF -0500 
SSR( REDUCED MODEL)= -14498170e+03 
0(Z,V,G) 
OPTIONS- S= 5, T= .0500, I=100, R=1, V=1l, G=l, P=0 
M+A(1)+B(9) 
THE RANK OF THE M DESIGN MATRIX IS 4 
ITS RATION 1, SSR(FULL MODEL)= ~15475333e+03, 
SSE (FULL MODEL)= -65366667e+01 

ESTIMATES OF EXPECT=D CELL MEANS- 

CELL FSSTIMATSCD MEAN 
- 26583333e+01 
-26583333e+01 (MISSING CELL) 
-36416667e+01 
-36416667e+01 
-27333333e4+401 
»27333333e+01 (MISSING CELL) 
-37166667e+01 (MISSING CELL) 
-37166667e+01 
- 37083333e+01 
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10 -37083333e+01 
11 -46916667e+01 
12 -46916667e+01 
G-INVERS= SOLUTION 
A 
l -.37500000e+00 
2 -.30000000e+00 
3 -67500000e+00 
B ; 
1 ~-49166667e+00 
2 -49166667e+00 
1 -35250000e+00 


Cc 


Another options statement is entered which suspends intermediate output and 
specifies the V and G option; again the status of the options is printed. A model 
statement representing the two-way classification without interaction for factors 
A and B is entered. All of the remaining computations are noniterative. Estimates 
of expected cell means are printed followed by a solution to the normal equations 
in response to the V and G options. Unfortunately, this example does not convey 
the algorithm’s facility to handle large data sets and diverse models. 


12. SUMMARY 


We have described a comprehensive algorithm for analysis of variance which has 
the facility to handle large problems involving unbalanced data on small com- 
puters. At the same time, the computational efficiencies common to balanced 
data are realized. Array storage economy is achieved by virtue of the fact that 
the algorithm performs vector operations as opposeci to matrix operations. Nei- 
ther the design matrix of indicator variables Xo nor the matrix XoXo is ever 
formed or stored. Ancillary computations and output amenities have been delib- 
erately limited to conserve program storage; however, the facility for algebraic 
problem specifications has been included. 

For some data sets and models requiring iteration, the algorithm may converge 
slowly so that it will be expensive timewise to achieve a high degree of accuracy; 
however, performance studies of the iterative AOV algorithm given in [10] and 
[6] indicate that the algorithm is likely to outperform matrix-oriented algorithms 
timewise on large problems with unbalanced data. It should always outperform 
these algorithms timewise when the data are balanced. Subsequent to submission 
of this algorithm, other authors [2], [15] have suggested using the conjugate 
gradient method rather than iterative improvement for the basic iterative step. 
The monotonicity properties of the algorithm are preserved with the conjugate 
gradient method, and performance should be improved whenever iteration for 
SSR is necessary. Subroutine step may be modified relatively easily to reflect 
using this method. 
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ALGORITHM 


[A part of the listing is printed here. The complete listing is available from the 
ACM Distribution Service.] 


**A COMPREHENSIVE, MATRIX FREE ALGORITHM FOR ANALYSIS OF VARIANCE** MAN 


MAN 

X*XSTATISTICS COMPUTED** MAN 
MAN 

1) CELL SUMS, FREQUENCIES, AND MEANS MAN 
MAN 

2) CLASSIFICATION SUMS, FREQUENCIES, AND MEANS MAN 
MAN 

3) RANK(DESIGN MATRIX FOR FULL MODEL) MAN 
MAN 

4) SSE(FULL MODEL) AND SSR(FULL. MODEL) MAN 
MAN 

5) A G-INVERSE SOLUTION TO THE NORMAL EQUATIONS MAN 
MAN 

6) ESTIMATES OF EXPECTED CELL MEANS MAN 
MAN 

7) RANK(RESTRICTED DESIGN MATRIX FOR REDUCED MODEL) MAN 
MAN 

8) SSE(REDUCED MODEL) AND SSR(REDUCED MODEL) MAN 
MAN 


9) THE F STATISTIC FOR A SPECIFIED HYPTOTHESIS MAN 
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MAN 226 

10) PROBABILITY OF A GREATER F GIVEN THE HYPOTHESIS MAN 230 
MAN 24@ 

**FLOW OF CONTROL** MAN 250 
MAN 260 

1) FACTOR, LEVELS STATEMENT MAN 270 
MAN 28@ 

2) VARIABLE FORMAT STATEMENT MAN 290 
MAN 300 

3) DATA MAN 310 
MAN 326 

4) BLANK LINE (CARD) MAN 33@ 
MAN 340 

5) OPTIONS STATEMENT/MODEL STATEMENT/HYPOTHESIS STATEMENT/ BLANK MAN 35¢@ 
LINE/E MAN 360 
MAN 37¢ 

E ENDS PROCESSING, BLANK LINE SENDS CONTROL TO 1), STATEMENTS MAN 38@ 
RETURN CONTROL TO 5) FOLLOWING EXECUTION. MAN 390 
MAN 40@ 

**FACTOR, LEVELS STATEMENT** MAN 410 
MAN 420 


A DISTINCT ALPHABETIC CHARACTER IS USED TO NAME ACH FACTOR AND MAN 430 
EACH SUBSCRIPT. THE STRING OF FACTOR SYMBOLS IS ?LACED IN PARENS MAN 44@ 


AND THEN PRECEDED BY THE LETTER F. THIS IS FOLLOWED BY THE LET- MAN 45@ 
TER L AND A PARENTHESIZED LIST OF ASSOCIATED SUBSCRIPTS WITH THE MAN 46@ 
NUMBER OF LEVELS FOR THE FACTOR IN PARENS FOLLOWING THE ASSOCI- MAN 476 
ATED SUBSCRIPT. MAN 480 
MAN 496 

EXAMPLE FOR 3 FACTORS NAMED A, B, C, ASSOCIATED SUBSCRIPTS NAMED MAN 500 
I, J, K, AND NUMBER OF LEVELS OF THE FACTORS EQUAL TO 5, 10, 15: MAN 51¢@ 
MAN 520 

F(A,B,C) L(1(5),J(1@),K(15)) MAN 530 
MAN 546 

COMMAS AND BLANKS ARE COSMETIC MAN 550 
MAN 560 


ORDERING OF THE ASSOCIATED SUBSCRIPTS IS ASSUMED TO CORRESPOND MAN 570 
TO THE ORDERING OF THE DATA. THE NUMBER OF OBSERVATIONS WITHIN MAN 580 
THE (1,J,K) CELL DEPENDS UPON THE DATA; NO SUBSCRIPT SYMBOL IS MAN 599 
USED TO DENOTE WITHIN CELL REPLICATION. MAN 60¢ 

MAN 610 
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